indy Activex Thread issues

Delphi'de kod yazma ile ilgili sorularınızı bu foruma yazabilirsiniz.
Kullanıcı avatarı
mia
Üye
Mesajlar: 239
Kayıt: 17 Nis 2015 01:18

indy Activex Thread issues

Mesaj gönderen mia » 18 Nis 2015 11:11

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
بِسْمِ اللهِ الرَّحْمنِ الرَّحِيمِ
in god i trust with every movement i do
graduated student and looking for knowledge

Kullanıcı avatarı
mrmarman
Üye
Mesajlar: 4731
Kayıt: 09 Ara 2003 08:13
Konum: Ankara
İletişim:

Re: indy Activex Thread issues

Mesaj gönderen mrmarman » 19 Nis 2015 06:06

Hi

- I prepared sort of projects for you, from stracth. click this link

- TServerSocket and TClientSocket never let you down :D

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.

Resim

Resim
Resim Resim

Kullanıcı avatarı
mia
Üye
Mesajlar: 239
Kayıt: 17 Nis 2015 01:18

Re: indy Activex Thread issues

Mesaj gönderen mia » 20 Nis 2015 04:52

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

Kullanıcı avatarı
mrmarman
Üye
Mesajlar: 4731
Kayıt: 09 Ara 2003 08:13
Konum: Ankara
İletişim:

Re: indy Activex Thread issues

Mesaj gönderen mrmarman » 20 Nis 2015 05:50

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...
Resim Resim

Kullanıcı avatarı
mia
Üye
Mesajlar: 239
Kayıt: 17 Nis 2015 01:18

Re: indy Activex Thread issues

Mesaj gönderen mia » 20 Nis 2015 06:27

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

Kullanıcı avatarı
mrmarman
Üye
Mesajlar: 4731
Kayıt: 09 Ara 2003 08:13
Konum: Ankara
İletişim:

Re: indy Activex Thread issues

Mesaj gönderen mrmarman » 20 Nis 2015 06:45

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.
Resim Resim

Kullanıcı avatarı
mia
Üye
Mesajlar: 239
Kayıt: 17 Nis 2015 01:18

Re: indy Activex Thread issues

Mesaj gönderen mia » 20 Nis 2015 06:51

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

Kullanıcı avatarı
mia
Üye
Mesajlar: 239
Kayıt: 17 Nis 2015 01:18

Re: indy Activex Thread issues

Mesaj gönderen mia » 20 Nis 2015 02:20

i started to have some pitfalls , some things did not understand it
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~');
//how to define

Kod: Tümünü seç

if command = ok then   mMessage.Lines.Add(strReceived);
and why you send ~ok~ command after adding ? can you add multiple command handler into the project to be more understandable please
بِسْمِ اللهِ الرَّحْمنِ الرَّحِيمِ
in god i trust with every movement i do
graduated student and looking for knowledge

Kullanıcı avatarı
mrmarman
Üye
Mesajlar: 4731
Kayıt: 09 Ara 2003 08:13
Konum: Ankara
İletişim:

Re: indy Activex Thread issues

Mesaj gönderen mrmarman » 20 Nis 2015 03:08

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

Kod: Tümünü seç

if pos( '~msg:',  strReceived)  > 0 then... 
TCP sends / receives text/strings.

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... 
Resim Resim

Kullanıcı avatarı
mia
Üye
Mesajlar: 239
Kayıt: 17 Nis 2015 01:18

Re: indy Activex Thread issues

Mesaj gönderen mia » 20 Nis 2015 11:26

lets say i want to send command called information of client i will assume that i will send username to server

Kod: Tümünü seç

client.socket.sendtext("information" , param of username) // i need to send username and define information as command 
how to handle this into the server to get only username like

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

Kullanıcı avatarı
mrmarman
Üye
Mesajlar: 4731
Kayıt: 09 Ara 2003 08:13
Konum: Ankara
İletişim:

Re: indy Activex Thread issues

Mesaj gönderen mrmarman » 21 Nis 2015 12:35

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 :

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;
or other way for short one

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;
Resim
Resim
Dosya ekleri
ParseSample.rar
(201.85 KiB) 40 kere indirildi
Resim Resim

Kullanıcı avatarı
mia
Üye
Mesajlar: 239
Kayıt: 17 Nis 2015 01:18

Re: indy Activex Thread issues

Mesaj gönderen mia » 26 Nis 2015 04:43

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

Kullanıcı avatarı
mrmarman
Üye
Mesajlar: 4731
Kayıt: 09 Ara 2003 08:13
Konum: Ankara
İletişim:

Re: indy Activex Thread issues

Mesaj gönderen mrmarman » 26 Nis 2015 05:05

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.
Resim Resim

Kullanıcı avatarı
mia
Üye
Mesajlar: 239
Kayıt: 17 Nis 2015 01:18

Re: indy Activex Thread issues

Mesaj gönderen mia » 26 Nis 2015 05:07

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

Kullanıcı avatarı
mrmarman
Üye
Mesajlar: 4731
Kayıt: 09 Ara 2003 08:13
Konum: Ankara
İletişim:

Re: indy Activex Thread issues

Mesaj gönderen mrmarman » 27 Nis 2015 05:59

Hi.

- I have had some free time for Indy / Threading ActiveX thing...
:idea: I insist, TServerSocket / TClientSocket twins are more comfortable than Indy sockets. :roll:

- 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)

Resim

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.
Client Helper Unit
--------------------------------------------------------------------------------

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.
Server Project
--------------------------------------------------------------------------------

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.
Client Project
--------------------------------------------------------------------------------

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 08:16 tarihinde düzenlendi, toplamda 4 kere düzenlendi.
Resim Resim

Cevapla