indy Activex Thread issues
Forum kuralları
Forum kurallarını okuyup, uyunuz!
Forum kurallarını okuyup, uyunuz!
indy Activex Thread issues
i have created my vcl project and i decided to create this project as activex too sadly threading not allowed in ActiveX. Since indy it's based on multi threading , any trick to handle this problem here is my complete client and server project , there is activex client and vcl client i cannot get my activex sendcommands working i been searchin for a while but i cannot found any solution here is my complete project
https://www.mediafire.com/?id35ooqr3pvnn9h
https://www.mediafire.com/?id35ooqr3pvnn9h
بِسْمِ اللهِ الرَّحْمنِ الرَّحِيمِ
in god i trust with every movement i do
graduated student and looking for knowledge
in god i trust with every movement i do
graduated student and looking for knowledge
Re: indy Activex Thread issues
Hi
- I prepared sort of projects for you, from stracth. click this link
- TServerSocket and TClientSocket never let you down
In this RAR package; you will see seperated (4) different project(s) will show you how to TServerSocket / TClientSocket use.
Also you will see, how to handle ActiveX (OCX) with sockets.
- I prepared sort of projects for you, from stracth. click this link
- TServerSocket and TClientSocket never let you down
In this RAR package; you will see seperated (4) different project(s) will show you how to TServerSocket / TClientSocket use.
Also you will see, how to handle ActiveX (OCX) with sockets.
Re: indy Activex Thread issues
this is huge help mrmarman , can i define too many commands to be handled by Tclient and server socket same as i did in indy iam really new with Tclient and server
بِسْمِ اللهِ الرَّحْمنِ الرَّحِيمِ
in god i trust with every movement i do
graduated student and looking for knowledge
in god i trust with every movement i do
graduated student and looking for knowledge
Re: indy Activex Thread issues
You're welcome, this is usual in this forum.
the answer is, sure you can but you'll not need i guess.
Indy has more ability on transfer files, ftp connection ext. more basicly. But TClientSocket and TServerSocket twins more flexible, just in my opinion.
There is just you need is deciding a protocol for machines between to do social.
I usually use tilda character ( ~) for communicating side for machines. This character is not formal, just your desicion to know wich command is for machine or the message user sent.
In this example i used "~ok~" to know that a transaction for a message has been finished. This is computer side dialogue and not to show user. This is the protocol that i describe above.
May be later, you want to say shut down a users computer with command ~shutdown:1234~ command and other user side app shuts down computer which unique id (in this example socket.handle which is 1234) without show any message. Because this message for machine, you got it...
the answer is, sure you can but you'll not need i guess.
Indy has more ability on transfer files, ftp connection ext. more basicly. But TClientSocket and TServerSocket twins more flexible, just in my opinion.
There is just you need is deciding a protocol for machines between to do social.
I usually use tilda character ( ~) for communicating side for machines. This character is not formal, just your desicion to know wich command is for machine or the message user sent.
In this example i used "~ok~" to know that a transaction for a message has been finished. This is computer side dialogue and not to show user. This is the protocol that i describe above.
May be later, you want to say shut down a users computer with command ~shutdown:1234~ command and other user side app shuts down computer which unique id (in this example socket.handle which is 1234) without show any message. Because this message for machine, you got it...
Re: indy Activex Thread issues
yes i started to understand but still some ideas in my mind getting unclear , as example i want to sent command that grab all current connected client to the server and show them to the clients ,, other example if i want to send command to specific client only not broadcast to every one also i want to include some parameters with command etc .. like each command have different approach , and thank you really for this huge help , that's awesome forum i have ever getting help on it
بِسْمِ اللهِ الرَّحْمنِ الرَّحِيمِ
in god i trust with every movement i do
graduated student and looking for knowledge
in god i trust with every movement i do
graduated student and looking for knowledge
Re: indy Activex Thread issues
Your both questions has one answer. This is the protocol that i mean.
You broadcast a message when Serversocket onClientConnect event. for example "~conn:arman@1234~"
all users clientapp. will take this command to their list as User arman connected. When user want to send a message to arman, user choose arman, but machine choose arman's unique id. Send message with self id attached like this '~msg:987@mia¦1234@arman^hello~
you parse this message, ~msg means this is a message, followed bye whom. and later take the to target user and finally message.
In this case, server knows which user sent a message to who.
You broadcast a message when Serversocket onClientConnect event. for example "~conn:arman@1234~"
all users clientapp. will take this command to their list as User arman connected. When user want to send a message to arman, user choose arman, but machine choose arman's unique id. Send message with self id attached like this '~msg:987@mia¦1234@arman^hello~
you parse this message, ~msg means this is a message, followed bye whom. and later take the to target user and finally message.
In this case, server knows which user sent a message to who.
Re: indy Activex Thread issues
Thank you mrmarman very much for the great help and source and this great informations, i will work around the project . thank you again .
بِسْمِ اللهِ الرَّحْمنِ الرَّحِيمِ
in god i trust with every movement i do
graduated student and looking for knowledge
in god i trust with every movement i do
graduated student and looking for knowledge
Re: indy Activex Thread issues
i started to have some pitfalls , some things did not understand it
server
// why its not equal (less or greater, not the same) i mean how i can handle some ~commands like this
other client pitfall
//how to define
and why you send ~ok~ command after adding ? can you add multiple command handler into the project to be more understandable please
server
Kod: Tümünü seç
if strReceived <> '~ok~' then
// why its not equal (less or greater, not the same) i mean how i can handle some ~commands like this
other client pitfall
Kod: Tümünü seç
strReceived := Socket.ReceiveText;
mMessage.Lines.Add(strReceived);
Socket.SendText('~ok~');
Kod: Tümünü seç
if command = ok then mMessage.Lines.Add(strReceived);
بِسْمِ اللهِ الرَّحْمنِ الرَّحِيمِ
in god i trust with every movement i do
graduated student and looking for knowledge
in god i trust with every movement i do
graduated student and looking for knowledge
Re: indy Activex Thread issues
Why ~ok~?
When server or client application closed, if a transaction has not been ended, an error will be raised. To prevent this situation I need to know, there is no active transaction. That means there is no message on the air/cable.
You may use OnClientError event to handle this may happens. ErrorCode :=0; is prevent the error message but my opinion this is not safe. IMHO this transaction must be in healty operation.
This little ~ok~ answer gives me 'yes I got it' meaning for the message who received. Like ping/pong...
Why not equals, this litle sample project only shows messages. This if clouse filters machine dialogue from user dialogs. If you didn't filter that, people dialods and machine protocols will be mixed, so an infinite message transactions will be begin.
you may use
TCP sends / receives text/strings.
Command = Ok
if these are Integers, you must translate strings to integer, or other types.
For example
When server or client application closed, if a transaction has not been ended, an error will be raised. To prevent this situation I need to know, there is no active transaction. That means there is no message on the air/cable.
You may use OnClientError event to handle this may happens. ErrorCode :=0; is prevent the error message but my opinion this is not safe. IMHO this transaction must be in healty operation.
This little ~ok~ answer gives me 'yes I got it' meaning for the message who received. Like ping/pong...
Why not equals, this litle sample project only shows messages. This if clouse filters machine dialogue from user dialogs. If you didn't filter that, people dialods and machine protocols will be mixed, so an infinite message transactions will be begin.
you may use
Kod: Tümünü seç
if pos( '~msg:', strReceived) > 0 then...
Command = Ok
if these are Integers, you must translate strings to integer, or other types.
For example
Kod: Tümünü seç
const
ok = 1;
var command : integer;
begin
if strReceived = '~ok~' then
command :=1;
...
...
if command = ok then...
Re: indy Activex Thread issues
lets say i want to send command called information of client i will assume that i will send username to server
how to handle this into the server to get only username like
Kod: Tümünü seç
client.socket.sendtext("information" , param of username) // i need to send username and define information as command
Kod: Tümünü seç
if command = "information" then
username = param of username
بِسْمِ اللهِ الرَّحْمنِ الرَّحِيمِ
in god i trust with every movement i do
graduated student and looking for knowledge
in god i trust with every movement i do
graduated student and looking for knowledge
Re: indy Activex Thread issues
You have multiple solutions...
- If you familiar by XML structure, you may send them by XML block.
- or if you say "I can parse which I decide string separators" then you make a string array (array I mean is concated strings with any separator character you want)
* after transfer server to client or other way; both solutions needs parse operation to seperate variables.
for example :
or other way for short one
- If you familiar by XML structure, you may send them by XML block.
- or if you say "I can parse which I decide string separators" then you make a string array (array I mean is concated strings with any separator character you want)
* after transfer server to client or other way; both solutions needs parse operation to seperate variables.
for example :
Kod: Tümünü seç
<msgblock>
<sender>arman</sender>
<uidsender>1234</uidsender>
<recipient>mia</recipient>
<uidrecipient>9876</uidrecipient>
<msg>hello</msg>
</msgblock>
Kod: Tümünü seç
Type tMessageBlock = record
Sender,
UIDSender,
Recipient,
UIDRecipient,
Msg : String
end;
function XMLParse( strMessage: String ): tMessageBlock;
function GetTag( strXML, strTag: String ): String;
begin
strXML := strMessage;
system.Delete(strXML, 1, Pos(strTag, strXML) + Length(strTag)-1);
Result := Trim( Copy(strXML,1, Pos('<', strXML)-1) );
end;
begin
FillChar( Result, SizeOf(Result), 0);
if Pos('<msgblock>', strMessage) > 0
then
With Result do begin
Sender := GetTag( strMessage, '<sender>' );
UIDSender := GetTag( strMessage, '<uidsender>' );
Recipient := GetTag( strMessage, '<recipient>' );
UIDRecipient := GetTag( strMessage, '<uidrecipient>' );
Msg := GetTag( strMessage, '<msg>' );
end;
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
With XMLParse( Memo1.Lines.Text )
do ShowMessageFmt('From: %s (%s), To: %s (%s)'#13'Message : %s', [Sender, UIDSender, Recipient, UIDRecipient, Msg]);
end;
Kod: Tümünü seç
~msg:arman@1234|mia@9876^hello~
Kod: Tümünü seç
Type tMessageBlock = record
Sender,
UIDSender,
Recipient,
UIDRecipient,
Msg : String
end;
function StrMsgParse( strMessage: String ): tMessageBlock;
Var
strFind : String;
begin // ~msg:arman@1234|mia@9876^hello~
FillChar( Result, SizeOf(Result), 0);
if Pos('~msg:', strMessage) > 0
then
With Result do begin
strFind := '~msg:';
System.Delete( strMessage, 1, Pos(strFind, strMessage) + Length(strFind)-1);
Sender := Copy(strMessage, 1, Pos('@', strMessage)-1);
System.Delete( strMessage, 1, Pos('@', strMessage) );
UIDSender := Copy(strMessage, 1, Pos('|', strMessage)-1);
System.Delete( strMessage, 1, Pos('|', strMessage) );
Recipient := Copy(strMessage, 1, Pos('@', strMessage)-1);
System.Delete( strMessage, 1, Pos('@', strMessage) );
UIDRecipient := Copy(strMessage, 1, Pos('^', strMessage)-1);
System.Delete( strMessage, 1, Pos('^', strMessage) );
Msg := Copy(strMessage, 1, Pos('~', strMessage)-1);
end;
end;
procedure TForm1.BitBtn2Click(Sender: TObject);
begin
With StrMsgParse( Edit1.Text )
do ShowMessageFmt('From: %s (%s), To: %s (%s)'#13'Message : %s', [Sender, UIDSender, Recipient, UIDRecipient, Msg]);
end;
- Dosya ekleri
-
- ParseSample.rar
- (201.09 KiB) 171 kere indirildi
Re: indy Activex Thread issues
mrmarman i wanted to set user detials , in server its used anyname i want to define each client with there id and username data i srongly need example with this i totaly fail to work with client socket , also about indy threading with active x there is no any solve to get it work ? i mean indy will be more helpful while using it on mobile app
بِسْمِ اللهِ الرَّحْمنِ الرَّحِيمِ
in god i trust with every movement i do
graduated student and looking for knowledge
in god i trust with every movement i do
graduated student and looking for knowledge
Re: indy Activex Thread issues
User details will be appending connection listview and/or local database table on the server side.
I will give you an example but i am working outside now.
and sure, I will make a try with indy sockets for you.
I will give you an example but i am working outside now.
and sure, I will make a try with indy sockets for you.
Re: indy Activex Thread issues
Thank you very much mrmarman this will help me alot you are a great person i dont know how to thank you more .
بِسْمِ اللهِ الرَّحْمنِ الرَّحِيمِ
in god i trust with every movement i do
graduated student and looking for knowledge
in god i trust with every movement i do
graduated student and looking for knowledge
Re: indy Activex Thread issues
Hi.
- I have had some free time for Indy / Threading ActiveX thing...
I insist, TServerSocket / TClientSocket twins are more comfortable than Indy sockets.
- I finished the principle part of project.
EDIT : New link below...
This is the updated link...
- I forgotten NickName Check block in remarks { } brackets... in activex OCX source.
project updated and sent to the file server after removed these brackets to work SignUp process...
( unit ActiveFormImpl )
What we do ?
(1) Transformed all of the TServerSocket / ClientSocket routines to the IdTCPServer / TIdTCPClient.
(2) Made a dynamic Database (MSAccess is easy to use for local database operations) which will record User base information and login history.
(3) If there is no database file then will be created automatically.
(4) Prepared two units named ServerHelper and ClientHelper for easy to understand what has done.
(5) User can Register with his/her information and chose a nickname. If nickname exists, user warned and forced to chose another one.
(6) This project pack also contains ActiveX OCX example. The hardest part was the thread work with ActiveX form.
This is an animated gif below that describes the workflow.
(Click image for start animation)
In the case of filehosting will be out of service, these are two main helper units I prepare.
Server Helper Unit
--------------------------------------------------------------------------------
Client Helper Unit
--------------------------------------------------------------------------------
Server Project
--------------------------------------------------------------------------------
Client Project
--------------------------------------------------------------------------------
- I have had some free time for Indy / Threading ActiveX thing...
I insist, TServerSocket / TClientSocket twins are more comfortable than Indy sockets.
- I finished the principle part of project.
EDIT : New link below...
This is the updated link...
- I forgotten NickName Check block in remarks { } brackets... in activex OCX source.
project updated and sent to the file server after removed these brackets to work SignUp process...
( unit ActiveFormImpl )
What we do ?
(1) Transformed all of the TServerSocket / ClientSocket routines to the IdTCPServer / TIdTCPClient.
(2) Made a dynamic Database (MSAccess is easy to use for local database operations) which will record User base information and login history.
(3) If there is no database file then will be created automatically.
(4) Prepared two units named ServerHelper and ClientHelper for easy to understand what has done.
(5) User can Register with his/her information and chose a nickname. If nickname exists, user warned and forced to chose another one.
(6) This project pack also contains ActiveX OCX example. The hardest part was the thread work with ActiveX form.
This is an animated gif below that describes the workflow.
(Click image for start animation)
In the case of filehosting will be out of service, these are two main helper units I prepare.
Server Helper Unit
--------------------------------------------------------------------------------
Kod: Tümünü seç
unit ServerHelper;
interface
Uses AdoDB, DB, SysUtils, ComObj, ActiveX, Variants, Classes, IdTCPServer, StdCtrls, Dialogs;
Type
TUserInfo = Record
U_Id,
U_NickName,
U_Name,
U_Sex,
U_Pass,
U_Email,
U_SignUp,
U_LastLogin,
U_Active,
U_Blocked,
U_SessionID : String;
end;
Procedure StartStop_Server( IdTCPServer:TIdTCPServer; LogMemo:TMemo );
procedure DatabasePrepare( strDatabase: String; ADOConnection: TAdoConnection );
function UserExistsOnDB( strUser, strPass : String; AdoConnection : TAdoConnection ): tUserInfo;
function UserUpdateDB( UserInfo : TUserInfo; AdoConnection : TAdoConnection ): tUserInfo;
function UserLoginProcess( U_Id:String; iSessionID:Integer; HasLogin:Boolean; ADOConnection:TADOConnection ): Boolean;
function UserInsertDB( UserInfo : TUserInfo; AdoConnection : TAdoConnection ): tUserInfo;
Function ParseXML( strXML, strTagName: String ): String;
Function HelloXML( DBInfo: TUserInfo; iSessionID: Integer ): String;
Function RefuseXML( U_NickName: String; iSessionID: Integer ): String;
Function UserFromXML( strXML: String ): TUserInfo;
Function UserListXML( U_Id:String; AdoConnection: TADOConnection): String;
Function UInfoFromUserId( U_Id:String; AdoConnection: TADOConnection): TUserInfo;
Function XMLComposeMessage( UserInfo:TUserInfo; strMessage: String): String;
Function XMLNickCheck( strNick: string; AdoConnection:TADOConnection ): boolean;
implementation
Procedure StartStop_Server( IdTCPServer:TIdTCPServer; LogMemo:TMemo );
begin
if NOT IdTCPServer.Active then // Server not active yet...
begin
try
IdTCPServer.DefaultPort := 1555;
IdTCPServer.Active := True;
if IdTCPServer.Active
then LogMemo.Lines.Add('Server started .... ')
else LogMemo.Lines.Add('ERROR. Cannot start server .... ');
except
LogMemo.Lines.Add('ERROR. Setting-up server .... ');
end;
end else
begin // Server allready active.
try
IdTCPServer.Active := False;
LogMemo.Lines.Add('Server stopped.... ');
except
LogMemo.Lines.Add('ERROR. Setting-up server .... ');
end;
end; // else
end;
procedure DatabasePrepare( strDatabase: String; ADOConnection: TAdoConnection );
Const
xBaglanti = 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s;';
var
Katalog : OleVariant;
strTablo : String;
begin
ADOConnection.ConnectionString := Format( xBaglanti, [strDatabase] );
ADOConnection.LoginPrompt := False;
if NOT DirectoryExists( ExtractFilePath(strDatabase) ) // CREATE database folder if not exists
then ForceDirectories( ExtractFilePath(strDatabase) );
if NOT FileExists( strDatabase ) then
begin // CREATE Database if not exists...
Katalog := CreateOleObject('ADOX.Catalog');
Katalog.Create( ADOConnection.ConnectionString );
Katalog := Unassigned; // Uses Variants
strTablo := 'CREATE TABLE UserTable ('
+ ' U_ID AutoIncrement CONSTRAINT idxRecID PRIMARY KEY '
+ ',U_NickName Text( 20 )'
+ ',U_Name Text( 60 )'
+ ',U_Pass Text( 20 )'
+ ',U_Email Text( 60 )'
+ ',U_Sex Text( 01 )'
+ ',U_SignUp DateTime'
+ ',U_LastLogin DateTime'
+ ',U_Active Logical'
+ ',U_Blocked Logical'
+ ',U_SessionID Integer'
+ ')';
With TADOCommand.Create(nil) do
begin
Connection := ADOConnection;
CommandText := strTablo;
Prepared := true;
Execute;
Free;
end;
end;
end;
function UserExistsOnDB( strUser, strPass : String; AdoConnection : TAdoConnection ): tUserInfo;
begin
FillChar(Result, SizeOf(Result), 0);
With TADOQuery.Create(nil) do
begin
Connection := ADOConnection;
SQL.Text := 'SELECT * FROM UserTable WHERE U_NickName = :U_NickName AND U_Pass =:U_Pass';
Parameters.ParamByName('U_NickName').Value := strUser;
Parameters.ParamByName('U_Pass').Value := strPass;
Active := True;
if NOT EOF then begin
Result.U_Id := FieldByName('U_Id').AsString;
Result.U_NickName := FieldByName('U_NickName').AsString;
Result.U_Name := FieldByName('U_Name').AsString;
Result.U_Sex := FieldByName('U_Sex').AsString;
Result.U_Pass := FieldByName('U_Pass').AsString;
Result.U_Email := FieldByName('U_Email').AsString;
Result.U_SignUp := FieldByName('U_SignUp').AsString;
Result.U_LastLogin := FieldByName('U_LastLogin').AsString;
Result.U_Active := FieldByName('U_Active').AsString;
Result.U_Blocked := FieldByName('U_Blocked').AsString;
end;
Active := False;
Free;
end;
end;
function UserUpdateDB( UserInfo : TUserInfo; AdoConnection : TAdoConnection ): tUserInfo;
begin
FillChar(Result, SizeOf(Result), 0);
With TADOQuery.Create(nil) do
begin
Connection := ADOConnection;
SQL.Text := 'UPDATE UserTable SET'
+ ',U_NickName = :U_NickName '
+ ',U_Name = :U_Name '
+ ',U_Pass = :U_Pass '
+ ',U_Email = :U_Email '
+ ',U_Sex = :U_Sex '
+ ',U_SignUp = :U_SignUp '
+ ',U_LastLogin = :U_LastLogin '
+ ',U_Active = :U_Active '
+ ',U_Blocked = :U_Blocked '
+ 'WHERE U_Id = :U_Id ';
With UserInfo do begin
Parameters.ParamByName('U_NickName').Value := U_NickName ;
Parameters.ParamByName('U_Name').Value := U_Name ;
Parameters.ParamByName('U_Pass').Value := U_Pass ;
Parameters.ParamByName('U_Email').Value := U_Email ;
Parameters.ParamByName('U_Sex').Value := U_Sex ;
Parameters.ParamByName('U_SignUp').Value := U_SignUp ;
Parameters.ParamByName('U_LastLogin').Value := U_LastLogin;
Parameters.ParamByName('U_Active').Value := U_Active ;
Parameters.ParamByName('U_Blocked').Value := U_Blocked ;
Parameters.ParamByName('U_Id').Value := U_Id ;
end;
ExecSQL;
Free;
end;
end;
function UserLoginProcess( U_Id:String; iSessionID:Integer; HasLogin:Boolean; ADOConnection:TADOConnection ): Boolean;
begin
Result := False;
With TADOQuery.Create(nil) do
begin
Connection := ADOConnection;
SQL.Clear;
SQL.Add('UPDATE UserTable SET');
SQL.Add(' U_LastLogin = :U_LastLogin ');
SQL.Add(', U_Active = :U_Active ');
SQL.Add(', U_SessionId = :U_SessionId ');
SQL.Add('WHERE 1=1');
if HasLogin then SQL.Add('AND U_Id = ' + U_Id )
else SQL.Add('AND U_SessionID = ' + IntToStr(iSessionID) );
Parameters.ParamByName('U_LastLogin').DataType := ftDateTime ;
Parameters.ParamByName('U_LastLogin').Value := Now();
Parameters.ParamByName('U_Active').Value := HasLogin;
Parameters.ParamByName('U_SessionID').Value := iSessionID;
Try
ExecSQL;
Result := True;
Except
End;
Free;
end;
end;
function UserInsertDB( UserInfo : TUserInfo; AdoConnection : TAdoConnection ): tUserInfo;
begin
FillChar(Result, SizeOf(Result), 0);
With TADOQuery.Create(nil) do
begin
Connection := ADOConnection;
SQL.Text := 'INSERT INTO UserTable ('
+ ' U_NickName '
+ ',U_Name '
+ ',U_Pass '
+ ',U_Email '
+ ',U_Sex '
+ ',U_SignUp '
+ ',U_LastLogin '
+ ',U_Active '
+ ',U_Blocked '
+ ') VALUES ( '
+ ' :U_NickName '
+ ',:U_Name '
+ ',:U_Pass '
+ ',:U_Email '
+ ',:U_Sex '
+ ',:U_SignUp '
+ ',:U_LastLogin '
+ ',:U_Active '
+ ',:U_Blocked '
+ ')';
With UserInfo do begin
Parameters.ParamByName('U_NickName').Value := U_NickName ;
Parameters.ParamByName('U_Name').Value := U_Name ;
Parameters.ParamByName('U_Pass').Value := U_Pass ;
Parameters.ParamByName('U_Email').Value := U_Email ;
Parameters.ParamByName('U_Sex').Value := U_Sex ;
Parameters.ParamByName('U_SignUp').DataType := ftDateTime ;
Parameters.ParamByName('U_SignUp').Value := Now() ;
Parameters.ParamByName('U_LastLogin').DataType := ftDateTime ;
Parameters.ParamByName('U_LastLogin').Value := Now();
Parameters.ParamByName('U_Active').Value := False;
Parameters.ParamByName('U_Blocked').Value := False;
end;
Try
ExecSQL;
Result := UserInfo;
SQL.Text := 'SELECT U_Id FROM UserTable WHERE U_NickName = :U_NickName AND U_Pass = :U_Pass';
Active := True;
if NOT EOF then Result.U_Id := FieldByName('U_Id').AsString;
Active := False;
Except
End;
Free;
end;
end;
Function ParseXML( strXML, strTagName: String ): String;
Var
strAra : String;
begin
strAra := '<' + strTagName + '>';
System.Delete( strXML, 1, Pos( strAra, strXML ) + Length(strAra)-1 );
Result := UTF8Decode( Trim( Copy(strXML, 1, Pos('<', strXML)-1) ) );
end;
Function HelloXML( DBInfo: TUserInfo; iSessionID: Integer ): String;
begin
With tStringList.Create do begin
Add('<Hello>');
Add('<U_Id>' +UTF8Encode(DBInfo.U_Id) +'</U_Id>');
Add('<U_NickName>' +UTF8Encode(DBInfo.U_NickName) +'</U_NickName>');
Add('<U_Name>' +UTF8Encode(DBInfo.U_Name) +'</U_Name>');
Add('<U_Email>' +UTF8Encode(DBInfo.U_Email) +'</U_Email>');
Add('<U_Sex>' +UTF8Encode(DBInfo.U_Sex) +'</U_Sex>');
Add('<U_SignUp>' +UTF8Encode(DBInfo.U_SignUp) +'</U_SignUp>');
Add('<U_LastLogin>' +UTF8Encode(DBInfo.U_LastLogin)+'</U_LastLogin>');
Add('<iSessionID>' +IntToStr(iSessionID) +'</iSessionID>');
Add('</Hello>');
Add('<~>');
Result := Text;
Free;
end;
end;
Function RefuseXML( U_NickName: String; iSessionID: Integer ): String;
begin
With tStringList.Create do begin
Add('<Refuse>');
Add('<U_NickName>'+UTF8Encode(U_NickName)+'</U_NickName>');
Add('<iSessionID>'+IntToStr(iSessionID) +'</iSessionID>');
Add('</Refuse>');
Add('<~>');
Result := Text;
Free;
end;
end;
Function UserFromXML( strXML: String ): TUserInfo;
begin
FillChar( Result, SizeOf(Result), 0);
Result.U_NickName := ParseXML( strXML, 'U_NickName' );
Result.U_Email := ParseXML( strXML, 'U_Email' );
Result.U_SignUp := ParseXML( strXML, 'U_SignUp' );
Result.U_LastLogin:= ParseXML( strXML, 'U_LastLogin' );
Result.U_Name := ParseXML( strXML, 'U_Name' );
Result.U_Sex := ParseXML( strXML, 'U_Sex' );
Result.U_Pass := ParseXML( strXML, 'U_Pass' );
Result.U_Active := ParseXML( strXML, 'U_Active' );
Result.U_Blocked := ParseXML( strXML, 'U_Blocked' );
Result.U_SessionID:= ParseXML( strXML, 'U_SessionID' );
end;
Function UserListXML( U_Id:String; AdoConnection: TADOConnection): String;
begin
With tStringList.Create do
begin
Add( '<UserList>' );
With TADOQuery.Create(nil) do
begin
Connection := ADOConnection;
SQL.Text := 'SELECT * FROM UserTable WHERE (U_Blocked is Null or U_Blocked = False) AND U_Id <> ' + U_Id;
Active := True;
while NOT EOF do
begin
Add( '<User>' );
Add( '<U_Id>' + FieldByName('U_Id' ).AsString + '<U_Id>' );
Add( '<U_NickName>' + FieldByName('U_NickName').AsString + '<U_NickName>' );
Add( '<U_Name>' + FieldByName('U_Name').AsString + '<U_Name>' );
Add( '<U_Pass>' + FieldByName('U_Pass').AsString + '<U_Pass>' );
Add( '<U_Email>' + FieldByName('U_Email').AsString + '<U_Email>' );
Add( '<U_Sex>' + FieldByName('U_Sex').AsString + '<U_Sex>' );
Add( '<U_SignUp>' + FieldByName('U_SignUp').AsString + '<U_SignUp>' );
Add( '<U_LastLogin>' + FieldByName('U_LastLogin').AsString + '<U_LastLogin>' );
Add( '<U_Active>' + FieldByName('U_Active').AsString + '<U_Active>' );
Add( '<U_Blocked>' + FieldByName('U_Blocked').AsString + '<U_Blocked>' );
Add( '<U_SessionID>' + FieldByName('U_SessionID').AsString + '<U_SessionID>' );
Add( '</User>' );
Next;
end;
Active := False;
Free;
end;
Add('</UserList>');
Add('<~>');
Result := Text;
Free;
end;
end;
Function UInfoFromUserId( U_Id:String; AdoConnection: TADOConnection): TUserInfo;
begin
FillChar( Result, SizeOf(Result), 0);
With TADOQuery.Create(nil) do
begin
Connection := ADOConnection;
SQL.Text := 'SELECT * FROM UserTable WHERE U_Id = ' + U_Id;
Active := True;
if NOT EOF
then begin
Result.U_Id := FieldByName('U_Id' ).AsString;
Result.U_NickName := FieldByName('U_NickName' ).AsString;
Result.U_Email := FieldByName('U_Email' ).AsString;
Result.U_SignUp := FieldByName('U_SignUp' ).AsString;
Result.U_LastLogin:= FieldByName('U_LastLogin' ).AsString;
Result.U_Name := FieldByName('U_Name' ).AsString;
Result.U_Sex := FieldByName('U_Sex' ).AsString;
Result.U_Pass := FieldByName('U_Pass' ).AsString;
Result.U_Active := FieldByName('U_Active' ).AsString;
Result.U_Blocked := FieldByName('U_Blocked' ).AsString;
Result.U_SessionID:= FieldByName('U_SessionID' ).AsString;
end;
Active := False;
Free;
end;
end;
Function XMLComposeMessage( UserInfo:TUserInfo; strMessage: String): String;
begin
With tStringList.Create do
begin
Add('<Message>' );
Add('<U_ID>' + UserInfo.U_Id + '</U_ID>' );
Add('<U_NickName>' + UserInfo.U_NickName + '</U_NickName>' );
Add('<Text>' + UTF8Encode( strMessage ) + '</Text>' );
Add('</Message>' );
Add('<~>');
Result := Text;
Free;
end;
end;
Function XMLNickCheck( strNick: string; AdoConnection:TADOConnection ): boolean;
begin
With TADOQuery.Create(nil) do
begin
Connection := ADOConnection;
SQL.Text := 'SELECT Count(*) as Nicks FROM UserTable WHERE UCASE(U_NickName) = :U_NickName';
Parameters.ParamByName('U_NickName').Value := UpperCase( strNick );
Active := True;
Result := FieldByName('Nicks').AsInteger = 0;
Active := False;
Free;
end;
end;
end.
--------------------------------------------------------------------------------
Kod: Tümünü seç
unit ClientHelper;
interface
Uses Classes, IdTCPConnection, IdSync, ComCtrls, SysUtils, StdCtrls;
type
TReadingThread = class(TThread)
protected
FConnection : TIdTCPConnection;
FLogResult : TStrings;
procedure Execute; override;
public
constructor Create(AConn: TIdTCPConnection; ALogResult: TStrings); reintroduce;
end;
Type
TUserInfo = Record
U_Id,
U_NickName,
U_Name,
U_Sex,
U_Pass,
U_Email,
U_SignUp,
U_LastLogin,
U_Active,
U_Blocked,
U_SessionID : String;
end;
function UserLoginInfoXML( U_NickName, U_Pass : String ): String;
Function ParseXML( strXML, strTagName: String ): String;
function XMLCommand( strUserID, strParam, strCommand: String ): String;
Function XMLNewUser( UserInfo:TUserInfo ): String;
Function XMLSendMessage( strSourceID, strTargetID, strMessage: String): String;
procedure XMLParseUserList( U_Id:Integer; strMessage: String; ListView: TListView );
Var
ListeningThread : TReadingThread = nil;
iUserID : Integer = -1;
implementation
function UserLoginInfoXML( U_NickName, U_Pass : String ): String;
begin
With tStringList.Create do begin
Add('<Login>');
Add('<U_NickName>'+UTF8Encode(U_NickName)+'</U_NickName>');
Add('<U_Pass>'+UTF8Encode(U_Pass)+'</U_Pass>');
Add('</Login>');
Result := Text;
Free;
end;
end;
Function ParseXML( strXML, strTagName: String ): String;
Var
strAra : String;
begin
strAra := '<' + strTagName + '>';
System.Delete( strXML, 1, Pos( strAra, strXML ) + Length(strAra)-1 );
Result := UTF8Decode( Trim( Copy(strXML, 1, Pos('<', strXML)-1) ) );
end;
function XMLCommand( strUserID, strParam, strCommand: String ): String;
begin
With tStringList.Create do
begin
Add('<CMD>');
if strCommand = 'refresh_user' then
begin
Add('<UserList><U_Id>' + strUserId + '</U_Id></UserList>');
end
else
if strCommand = 'nickname_check' then
begin
Add('<NickCheck>' + strParam + '</NickCheck>');
end;
Add('</CMD>');
Add('<~>');
Result := Text;
Free;
end;
end;
Function XMLNewUser( UserInfo:TUserInfo ): String;
begin
With tStringList.Create do
begin
Add('<NewUser>' );
// Add('<U_Id>' + UserInfo.U_Id + '</U_Id>' );
Add('<U_NickName>' + UserInfo.U_NickName + '</U_NickName>' );
Add('<U_Name>' + UserInfo.U_Name + '</U_Name>' );
Add('<U_Pass>' + UserInfo.U_Pass + '</U_Pass>' );
Add('<U_Email>' + UserInfo.U_Email + '</U_Email>' );
Add('<U_Sex>' + UserInfo.U_Sex + '</U_Sex>' );
// Add('<U_SignUp>' + UserInfo.U_SignUp + '</U_SignUp>' );
// Add('<U_LastLogin>'+ UserInfo.U_LastLogin + '</U_LastLogin>' );
// Add('<U_Active>' + UserInfo.U_Active + '</U_Active>' );
// Add('<U_Blocked>' + UserInfo.U_Blocked + '</U_Blocked>' );
Add('</NewUser>' );
Add('<~>');
Result := Text;
Free;
end;
end;
Function XMLSendMessage( strSourceID, strTargetID, strMessage: String): String;
begin
With tStringList.Create do
begin
Add('<Message>' );
Add('<SourceID>' + strSourceID + '</SourceID>' );
Add('<TargetID>' + strTargetID + '</TargetID>' );
Add('<Text>' + UTF8Encode( strMessage ) + '</Text>' );
Add('</Message>' );
Add('<~>');
Result := Text;
Free;
end;
end;
procedure XMLParseUserList( U_Id:Integer; strMessage: String; ListView: TListView );
Var
strAra, strBlock : String;
strSelectedId : String;
begin
strSelectedId := '';
if ListView.Selected <> nil
then strSelectedId := ListView.Selected.SubItems[0];
ListView.Clear;
while POS('<User>', strMessage) > 0 do begin
strAra := '<User>';
System.Delete( strMessage, 1, Pos(strAra, strMessage) + Length(strAra)-1);
strBlock := Copy(strMessage, 1, Pos('</User>', strMessage)-1 );
if ParseXML( strBlock, 'U_Id' ) <> IntToStr( U_Id ) then
With ListView.Items.Add do begin
Caption := ParseXML( strBlock, 'U_Id' );
SubItems.Add( ParseXML( strBlock, 'U_NickName' ) );
SubItems.Add( ParseXML( strBlock, 'U_Email' ) );
SubItems.Add( ParseXML( strBlock, 'U_LastLogin' ) );
SubItems.Add( ParseXML( strBlock, 'U_SignUp' ) );
// Hidden...
SubItems.Add( ParseXML( strBlock, 'U_Name' ) );
SubItems.Add( ParseXML( strBlock, 'U_Sex' ) );
SubItems.Add( ParseXML( strBlock, 'U_Pass' ) );
SubItems.Add( ParseXML( strBlock, 'U_Active' ) );
SubItems.Add( ParseXML( strBlock, 'U_Blocked' ) );
if LowerCase( SubItems[5] ) = 'm'
then StateIndex := 1
else StateIndex := 2;
if LowerCase( SubItems[7] ) = 'false'
then SubItems[0] := '(OffLine) ' + SubItems[0];
end;
end;
end;
{ TReadingThread }
constructor TReadingThread.Create(AConn: TIdTCPConnection; ALogResult: TStrings);
begin
FConnection := AConn;
FLogResult := ALogResult;
inherited Create(False);
end;
procedure TReadingThread.Execute;
Var
strData : String;
begin
while not Terminated do
begin
try
strData := FConnection.IOHandler.ReadLn;
if strData <> '' then
begin
FLogResult.Add( strData );
end;
except
on E: Exception do
begin
FConnection.Disconnect(False);
if FConnection.IOHandler <> nil
then FConnection.IOHandler.InputBuffer.Clear;
Break;
end;
end;
Sleep(1);
end; // While
end;
end.
--------------------------------------------------------------------------------
Kod: Tümünü seç
USES ServerHelper;
procedure TForm1.FormShow(Sender: TObject);
begin
DatabasePrepare( ExtractFilePath(Application.ExeName) + 'DATA\Database.mdb', AdoConnection1 );
ADOQuery1.Connection := ADOConnection1;
DataSource1.DataSet := ADOQuery1;
DBGrid1.DataSource := DataSource1;
ADOQuery1.SQL.Text := 'SELECT * FROM UserTable';
ADOQuery1.Active := True;
StartStop_Server( IdTCPServer1, Memo1 ); // Start Server
end;
procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
Var
strIp : String;
iSessionID : Integer;
Begin
strIp := AContext.Connection.Socket.Binding.IP;
iSessionID := AContext.Connection.Socket.Binding.Handle;
// we will use Socket Handle as SessionID
// because it may many connections from the same IP
// We will know with this which one is on OnDisconnect event :)
// We put the SessionID to the TObject.
AContext.Data := TObject( Integer( iSessionID ) );
Memo1.Lines.Add( Format('Connected : IP= %s, SessionID= %d', [strIp, iSessionID]) );
end;
procedure TForm1.IdTCPServer1Disconnect(AContext: TIdContext);
Var
strIp, strTemp : String;
iSessionID : Integer;
i : Integer;
TCPClients : TList;
Begin
strIp := AContext.Connection.Socket.Binding.IP;
iSessionID := Integer( AContext.Data );
AContext.Data := Nil; // We must empty the DATA
Memo1.Lines.Add( Format('Disconnected : IP= %s, SessionID= %d', [strIp, iSessionID]) );
UserLoginProcess( 'n/a', iSessionID, False, ADOConnection1 );
ADOQuery1.Requery();
ADOQuery1.Locate( 'U_SessionID', iSessionID, [loCaseInsensitive] );
for i := ListView1.Items.Count- 1 downto 0 do
if IntToStr( iSessionID ) = ListView1.Items[i].SubItems[4]
then ListView1.Items.Delete(i);
// Refersh client's apps UserList
strTemp := UserListXML( '-1', ADOConnection1 );
TCPClients := IdTCPServer1.Contexts.LockList;
Try
for i := 0 to TCPClients.Count - 1 do
begin
try
TIdContext(TCPClients[i]).Connection.Socket.WriteLn( strTemp );
except
end;
end;
finally
IdTCPServer1.Contexts.UnlockList;
end;
end;
procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
Var
strLine, strMsg, strIp, strTemp : String;
iSessionID, i : Integer;
USourceInfo, UTargetInfo : TUserInfo;
UserInfo, DBInfo : TUserInfo;
TCPClients : TList;
Begin
strIp := AContext.Connection.Socket.Binding.IP;
strMsg := '';
strLine := '*';
while strLine <> '' do
begin
strLine := AContext.Connection.IOHandler.ReadLn;
strMsg := strMsg + strLine;
end;
iSessionID := Integer( AContext.Data );
if Pos('<Login>', strMsg) > 0 then
begin // Login Information incoming...
FillChar( UserInfo, SizeOf(UserInfo), 0 );
UserInfo.U_NickName := ParseXML( strMsg, 'U_NickName' );
UserInfo.U_Pass := ParseXML( strMsg, 'U_Pass' );
DBInfo := UserExistsOnDB( UserInfo.U_NickName, UserInfo.U_Pass, ADOConnection1 );
if DBInfo.U_Name <> '' then
begin
AContext.Connection.Socket.WriteLn( HelloXML( DBInfo, iSessionID ) );
Memo1.Lines.Add( Format('USER Login: User "%s" (%s) connected with "%s" nickname (SesID:%d)', [ DBInfo.U_Name, DBInfo.U_NickName, DBInfo.U_Email, iSessionID ]) );
UserLoginProcess( DBInfo.U_Id, iSessionID, True, ADOConnection1 );
ADOQuery1.Requery();
ADOQuery1.Locate( 'U_SessionID', iSessionID, [loCaseInsensitive] );
With ListView1.Items.Add do
begin
Caption := '';
SubItems.Add( DBInfo.U_NickName );
SubItems.Add( AContext.Connection.Socket.Binding.IP );
SubItems.Add( DBInfo.U_Name );
SubItems.Add( DBInfo.U_Id );
SubItems.Add( IntToStr(iSessionID) );
SubItems.Add( DBInfo.U_Email );
SubItems.Add( DBInfo.U_Sex );
SubItems.Add( DBInfo.U_LastLogin );
SubItems.Add( DBInfo.U_SignUp );
end;
// Refersh client's apps UserList
strTemp := UserListXML( '-1', ADOConnection1 );
TCPClients := IdTCPServer1.Contexts.LockList;
Try
for i := 0 to TCPClients.Count - 1 do
begin
try
TIdContext(TCPClients[i]).Connection.Socket.WriteLn( strTemp );
except
end;
end;
finally
IdTCPServer1.Contexts.UnlockList;
end;
end else begin
AContext.Connection.Socket.WriteLn( RefuseXML( UserInfo.U_NickName, iSessionID ) );
AContext.Connection.IOHandler.Close;
AContext.Connection.Disconnect;
Memo1.Lines.Add( Format('Illegal Login attempt: with "%s" nickname (SesID:%d)', [ UserInfo.U_NickName, iSessionID ]) );
end;
end else
if Pos('<NewUser>', strMsg) > 0 then
begin
UserInfo := UserFromXML( strMsg );
if UserInsertDB( UserInfo, ADOConnection1 ).U_Id <> ''
then begin
AContext.Connection.Socket.WriteLn( '<NewUserResult><U_Name>'+UserInfo.U_Name+'</U_Name><Result>OK</Result></NewUserResult><~>' );
Memo1.Lines.Add( Format('New User append successfully...: "%s" (SesID:%d)', [ strTemp, iSessionID ]) );
ADOQuery1.Requery();
ADOQuery1.Locate( 'U_SessionID', iSessionID, [loCaseInsensitive] );
end
else begin
AContext.Connection.Socket.WriteLn( '<NewUserResult><U_Name>'+UserInfo.U_Name+'</U_Name><Result>ERROR</Result></NewUserResult><~>' );
Memo1.Lines.Add( Format('New User cannot be record, there was an error...: "%s" (SesID:%d)', [ strTemp, iSessionID ]) );
end;
end else
if Pos('<Message>', strMsg) > 0 then
begin
USourceInfo := UInfoFromUserId( ParseXML(strMsg, 'SourceID'), ADOConnection1 );
UTargetInfo := UInfoFromUserId( ParseXML(strMsg, 'TargetID'), ADOConnection1 );
if UTargetInfo.U_Active = 'True' then
begin
TCPClients := IdTCPServer1.Contexts.LockList;
Try
for i := 0 to TCPClients.Count - 1 do
begin
try
if Integer( TIdContext(TCPClients[i]).Data ) = StrToInt(UTargetInfo.U_SessionID) then
begin
TIdContext(TCPClients[i]).Connection.Socket.WriteLn( XMLComposeMessage( USourceInfo, ParseXML(strMsg, 'Text') ) );
AContext.Connection.Socket.WriteLn( '<MessageResult><U_Name>'+UTargetInfo.U_Name+'</U_Name><Result>OK</Result></MessageResult><~>' );
Memo1.Lines.Add( Format('Sent message : (%s -> %s) "%s"', [USourceInfo.U_NickName, UTargetInfo.U_NickName, ParseXML(strMsg, 'Text') ] ) );
end;
except
end;
end;
finally
IdTCPServer1.Contexts.UnlockList;
end;
end else
begin
AContext.Connection.Socket.WriteLn( '<MessageResult><U_Name>'+UTargetInfo.U_Name+'</U_Name><Result>ERROR</Result></MessageResult><~>' );
Memo1.Lines.Add( Format('Cannot sent message (Target user not active) : (%s -> %s) "%s"', [USourceInfo.U_NickName, UTargetInfo.U_NickName, ParseXML(strMsg, 'Text') ] ) );
end;
end else
if Pos('<CMD>', strMsg ) > 0 then
begin
if Pos('<NickCheck>', strMsg) > 0 then
begin
Memo1.Lines.Add( 'Attempted to NickName check...' );
strTemp := ParseXML( strMsg, 'NickCheck' );
if XMLNickCheck( strTemp, ADOConnection1 ) then
begin
AContext.Connection.Socket.WriteLn( '<NickResult><Nick>'+strTemp+'</Nick><Result>OK</Result></NickResult><~>' );
Memo1.Lines.Add( Format('NickName check. (Yes it avails) : "%s" (SesID:%d)', [ strTemp, iSessionID ]) );
end else
begin
AContext.Connection.Socket.WriteLn( '<NickResult><Nick>'+strTemp+'</Nick><Result>NOT</Result></NickResult><~>' );
Memo1.Lines.Add( Format('NickName check (No not available) : "%s" (SesID:%d)', [ strTemp, iSessionID ]) );
end;
AContext.Connection.IOHandler.Close;
AContext.Connection.Disconnect;
end else
if Pos('<UserList>', strMsg) > 0 then
begin
FillChar( UserInfo, SizeOf(UserInfo), 0 );
UserInfo := UInfoFromUserId( ParseXML( strMsg, 'U_Id' ), ADOConnection1 );
AContext.Connection.Socket.WriteLn( UserListXML( UserInfo.U_Id, ADOConnection1 ) );
Memo1.Lines.Add( Format('USER List Sent: User "%s" (%s) connected with "%s" nickname (SesID:%d)', [ UserInfo.U_Name, UserInfo.U_NickName, UserInfo.U_Email, iSessionID ]) );
end;
end else
begin
AContext.Connection.Socket.WriteLn( RefuseXML( UserInfo.U_NickName, iSessionID ) );
AContext.Connection.IOHandler.Close;
AContext.Connection.Disconnect;
Memo1.Lines.Add( Format('Illegal Protocol attempt: with "%s" nickname (SesID:%d)', [ UserInfo.U_NickName, iSessionID ]) );
end;
end;
end.
--------------------------------------------------------------------------------
Kod: Tümünü seç
uses ClientHelper;
{$R *.dfm}
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
if NOT IdTCPClient1.Connected
then begin
IdTCPClient1.Host := Edit4.Text;
IdTCPClient1.Port := SpinEdit1.Value;
IdTCPClient1.ConnectTimeout := 10000;
Try
IdTCPClient1.Connect;
IdTCPClient1.Socket.WriteLn( UserLoginInfoXML( Edit2.Text, Edit3.Text ) );
Except;
MessageDlg('Cannot reach to server..., please try later...', mtError, [mbOk], 0);
End;
end
else begin
IdTCPClient1.Disconnect;
if IdTCPClient1.IOHandler <> nil
then IdTCPClient1.IOHandler.InputBuffer.Clear;
end;
end;
procedure TForm1.BitBtn5Click(Sender: TObject);
Var
strTemp : String;
begin
strTemp := Edit1.Text;
// if InputQuery( 'Nickname check', 'Nickname', strTemp) then
begin
if NOT IdTCPClient1.Connected
then begin
IdTCPClient1.Host := Edit4.Text;
IdTCPClient1.Port := SpinEdit1.Value;
IdTCPClient1.ConnectTimeout := 10000;
Try
IdTCPClient1.Connect;
Except;
MessageDlg('Cannot reach to server..., please try later...', mtError, [mbOk], 0);
Exit;
End;
end;
IdTCPClient1.Socket.WriteLn( XMLCommand( 'n/a', strTemp, 'nickname_check') );
end;
end;
procedure TForm1.Edit1Change(Sender: TObject);
begin
Label10.Caption := 'Please use check availability button...';
BitBtn3.Enabled := False;
end;
procedure TForm1.BitBtn2Click(Sender: TObject);
begin
if ListView1.Selected = Nil then
begin
MessageDlg('Please select an active user first to send message...', mtInformation, [mbOk], 0 );
Exit;
end;
IdTCPClient1.Socket.WriteLn( XMLSendMessage( IntToStr(iUserID), ListView1.Selected.Caption, Memo3.Text) );
end;
procedure TForm1.BitBtn3Click(Sender: TObject);
Var
UserInfo : TUserInfo;
begin
if Edit6.Text = Edit7.Text then
begin
UserInfo.U_NickName := Edit1.Text;
UserInfo.U_Name := Edit5.Text;
case RadioGroup1.ItemIndex of
0 : UserInfo.U_Sex := 'm';
1 : UserInfo.U_Sex := 'f';
end;
UserInfo.U_Pass := Edit6.Text;
UserInfo.U_Email := Edit8.Text;
if NOT IdTCPClient1.Connected
then begin
IdTCPClient1.Host := Edit4.Text;
IdTCPClient1.Port := SpinEdit1.Value;
IdTCPClient1.ConnectTimeout := 10000;
Try
IdTCPClient1.Connect;
Except;
MessageDlg('Cannot reach to server..., please try later...', mtError, [mbOk], 0);
Exit;
End;
end;
IdTCPClient1.Socket.WriteLn( XMLNewUser( UserInfo ) );
end
else MessageDlg('Passwords not match...', mterror, [mbOk], 0 );
end;
procedure TForm1.BitBtn4Click(Sender: TObject);
begin
IdTCPClient1.Socket.WriteLn( XMLCommand( IntToStr(iUserID), 'n/a', 'refresh_user') );
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Image1.Visible := False;
Image2.Visible := False;
ListView1.StateImages := ImageList1;
ListView1.ReadOnly := True;
end;
procedure TForm1.IdTCPClient1Connected(Sender: TObject);
begin
ListeningThread := TReadingThread.Create( IdTCPClient1, Memo2.Lines );
Memo1.Lines.Add('Connected to server...');
end;
procedure TForm1.IdTCPClient1Disconnected(Sender: TObject);
begin
Memo1.Lines.Add('Connection closing, please wait for process...');
if ListeningThread <> nil then
begin
ListeningThread.Terminate;
ListeningThread.WaitFor;
FreeAndNil(ListeningThread);
end;
Memo1.Lines.Add('Disconnected from server...');
iUserID := -1;
Image1.Visible := False;
Image2.Visible := False;
end;
procedure TForm1.Memo2Change(Sender: TObject);
Var
strMsg : String;
begin
strMsg := TMemo(Sender).Text;
if Pos('<~>', strMsg) > 0 then
begin
// Synchronized / Incoming Message Event is Here...
if Pos( '<Refuse>', strMsg ) > 0 then
begin
Memo1.Lines.Add( 'Refused user ' + Edit2.Text + ' by the server...'#13'Please input correct info or SignUp for Registration' );
//MessageDlg('Refused user ' + Edit2.Text + ' by the server...'#13'Please input correct info or SignUp for Registration', mtWarning, [mbOk], 0 );
IdTCPClient1.Disconnect;
IdTCPClient1.IOHandler.InputBuffer.clear;
iUserID := -1;
end else
if Pos( '<Hello>', strMsg ) > 0 then
begin
Memo1.Lines.Add( 'Hello ' + ParseXML(strMsg, 'U_Name') + '...'#13'You logged in successfully....' );
Memo1.Lines.Add( ' You joined on ' + ParseXML(strMsg, 'U_SignUp') );
Memo1.Lines.Add( ' Last login on ' + ParseXML(strMsg, 'U_LastLogin') );
if LowerCase( ParseXML(strMsg, 'U_Sex') ) = 'm'
then Image1.Visible := True
else Image2.Visible := True;
Image2.Visible := NOT Image1.Visible;
iUserID := StrToInt( ParseXML(strMsg, 'U_Id') );
end else
if Pos( '<UserList>', strMsg ) > 0 then
begin
XMLParseUserList( iUserID, strMsg, ListView1 );
end else
if Pos( '<NewUserResult>', strMsg ) > 0 then
begin
if ParseXML(strMsg, 'Result') = 'OK'
then begin
Memo1.Lines.Add( 'Welcome "' + ParseXML(strMsg, 'U_Name') + '" to the Chat room...');
end else
begin
Memo1.Lines.Add( 'We are sorry "' + ParseXML(strMsg, 'U_Name') + '" There ise a problem on server with registration. Please try again..."');
end;
end else
if Pos( '<Message>', strMsg ) > 0 then
begin
Memo1.Lines.Add( 'Message From "' + ParseXML(strMsg, 'U_NickName') + '" : ' + ParseXML(strMsg, 'Text') );
end else
if Pos( '<MessageResult>', strMsg ) > 0 then
begin
if ParseXML(strMsg, 'Result') = 'OK'
then begin
Memo1.Lines.Add( 'message sent to "' + ParseXML(strMsg, 'U_Name') + '" succesfully');
end else
begin
Memo1.Lines.Add( 'ERROR: message cannot be sent to "' + ParseXML(strMsg, 'U_Name') + '"');
Memo1.Lines.Add( 'We are sorry "' + ParseXML(strMsg, 'U_Name') + '" may be OffLine"');
end;
end else
if Pos( '<NickResult>', strMsg ) > 0 then
begin
if ParseXML(strMsg, 'Result') = 'OK'
then begin
Memo1.Lines.Add( 'Yes, your selected NickName "'+ ParseXML(strMsg, 'Nick')+ '" is availavle');
Label10.Caption := 'Yes, nickname "'+ ParseXML(strMsg, 'Nick')+ '" is available';
BitBtn3.Enabled := True;
end
else begin
Memo1.Lines.Add( 'Sorry, your selected NickName "'+ ParseXML(strMsg, 'Nick')+ '" is NOT availavle');
Label10.Caption := 'No, nickname "'+ ParseXML(strMsg, 'Nick')+ '" is not available';
BitBtn3.Enabled := False;
end;
end;
TMemo(Sender).Clear;
end;
end;
procedure TForm1.TabSheet2Show(Sender: TObject);
begin
Edit1Change(Edit1);
end;
En son mrmarman tarafından 27 Nis 2015 09:16 tarihinde düzenlendi, toplamda 4 kere düzenlendi.