Delphi World - Создание простого чата на Delphi

Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...

Создание простого чата на Delphi - Часть 1

Автор: RT17

Данная статья является пробным камнем в огород Delphi-чатстроительства... в дальнейшем возможна организация полного цикла подробных статей о создании целостного чат-сервера на Delphi...

Итак, требуется создать чат-сервер на Delphi - ну так давайте сразу из огня да в полымя... Во-первых, сразу разберемся - а что такое чат с точки зрения программиста? Да нет ничего проще - имеем один общедоступный ресурс, в который, по идее, должны складываться все фразы, посланные каждым пользователем и плюс механизмы для передачи от каждого пользователя его посланий в этот ресурс и наоборот - передачи всех (или не всех) данных этого ресурса всем (или,опять же, не всем) пользователям. Вот, если не все, то почти все...

А теперь рассмотрим класс TChat в котором реализовано основа, можно сказать "ядро" чата, все сообщения.

unit ChatClass;
interface
uses DB, ADODB, Dialogs, SysUtils;

Type
        TChat = class (TObject)
       private
          ADOConnection                 : TADOConnection; //Подсоединение
          ADOQuery                      : TADOQuery;      //Переменная для набора данных
          ConnectStr                    : string;
          ChatDataBasePublic            : string;         //Имена баз данных (Для всех)
          ChatDataBasePrivate           : string;         //Имена баз данных (Приват)
          MaxPageSizeForBasePublic      : Integer;        //Макс. записей для (Для всех)
          MaxPageSizeForBasePrivate     : Integer;        //Макс. записей для (Для всех)
        procedure Update; overload;
        procedure Delete; overload;
        procedure Update(UserID : Integer); overload;
        procedure Delete(UserID : Integer); overload;
       public
        constructor Create;
        destructor Destroy; override;
        procedure SentMessagePublic  (Message : string);  //Поcылаем сообщение (Для всех)
        procedure SentMessagePrivate (Message : string; UserID : Integer); //Поcылаем сообщение (Приват)
        function  GetMessagePublic   (MaxPageSizeForUser : Integer) : string; //Получаем сообщение (Для всех)
        function  GetMessagePrivate  (MaxPageSizeForUser : Integer; UserID : Integer) : string; //Получаем сообщение (Приват)
        procedure Open;
        procedure Close;
       published
        property ConnectionString : string read ConnectStr write ConnectStr;
        property DataBasePublic  : string read ChatDataBasePublic write ChatDataBasePublic;
        property DataBasePrivate : string read ChatDataBasePrivate write ChatDataBasePrivate;
        property PageSizeForBasePublic  : Integer read MaxPageSizeForBasePublic
                                                                write MaxPageSizeForBasePublic;
        property PageSizeForBasePrivate : Integer read MaxPageSizeForBasePrivate
                                                                write MaxPageSizeForBasePrivate;
end;

implementation

constructor TChat.Create;
begin
    ADOConnection         := TADOConnection.Create(nil);
    ADOQuery              := TADOQuery.Create(nil);
end;

destructor TChat.Destroy;
begin
       if ADOConnection <> nil then Close;
end;

procedure TChat.SentMessagePublic  (Message : string);
begin
        Update;
        Delete;
        ADOQuery.Close;
        ADOQuery.SQL.Clear;
        ADOQuery.SQL.Add('INSERT INTO '+ChatDataBasePublic+' (Message, MessagePosition) VALUES(?, ?)');
        ADOQuery.Parameters.Items[0].Value:=Message;
        ADOQuery.Parameters.Items[1].Value:=1;
        ADOQuery.ExecSQL;
end;

procedure TChat.SentMessagePrivate (Message : string; UserID : Integer);
begin
        Update(UserID);
        Delete(UserID);
        ADOQuery.Close;
        ADOQuery.SQL.Clear;
        ADOQuery.SQL.Add('INSERT INTO '+ ChatDataBasePrivate +' (Message, MessagePosition, UserID) VALUES(?, ?, ?)');
        ADOQuery.Parameters.Items[0].Value:=Message;
        ADOQuery.Parameters.Items[1].Value:=1;
        ADOQuery.Parameters.Items[2].Value:=UserID;
        ADOQuery.ExecSQL;
end;

function  TChat.GetMessagePublic   (MaxPageSizeForUser : Integer) : string;
var
        Temp    : Integer;
        Max     : Integer;
begin
        Result:='';
        ADOQuery.Close;
        ADOQuery.SQL.Clear;
        ADOQuery.SQL.Add('SELECT Message FROM '+ ChatDataBasePublic + ' ORDER BY MessagePosition');
        ADOQuery.Open;
        if MaxPageSizeForUser > ADOQuery.RecordCount then
                Max := ADOQuery.RecordCount
            else
                Max := MaxPageSizeForUser;
           for Temp:=1 to Max do
                begin
                        Result:=Result + ADOQuery.FieldByName('Message').AsString;
                        ADOQuery.Next;
                end;
end;

function  TChat.GetMessagePrivate  (MaxPageSizeForUser : Integer; UserID : Integer) : string;
var
        Temp    : Integer;
        Max     : Integer;
begin
        Result:='';
        ADOQuery.Close;
        ADOQuery.SQL.Clear;
        ADOQuery.SQL.Add('SELECT * FROM ' + ChatDataBasePrivate +
                                ' WHERE UserID='+ Inttostr(UserID) +' ORDER BY MessagePosition');
        ADOQuery.Open;
        if MaxPageSizeForUser > ADOQuery.RecordCount then
                Max := ADOQuery.RecordCount
            else
                Max := MaxPageSizeForUser;
           for Temp:=1 to Max do
                begin
                        Result:=Result + ADOQuery.FieldByName('Message').AsString;
                        ADOQuery.Next;
                end;
end;

procedure TChat.Open;
begin
        ADOConnection.ConnectionString:=ConnectStr;
        ADOConnection.Open;
        ADOQuery.Connection:=ADOConnection;
end;

procedure TChat.Update;
begin
        ADOQuery.Close;
        ADOQuery.SQL.Clear;
        ADOQuery.SQL.Add('UPDATE '+ChatDataBasePublic+' SET MessagePosition = MessagePosition + 1');
        ADOQuery.ExecSQL;
end;

procedure TChat.Delete;
begin
        ADOQuery.Close;
        ADOQuery.SQL.Clear;
        ADOQuery.SQL.Add('DELETE FROM '+ChatDataBasePublic+' WHERE MessagePosition>?');
        ADOQuery.Parameters.Items[0].Value:=MaxPageSizeForBasePublic;
        ADOQuery.ExecSQL;
end;

procedure TChat.Update(UserID : Integer);
begin
        ADOQuery.Close;
        ADOQuery.SQL.Clear;
        ADOQuery.SQL.Add('UPDATE '+ChatDataBasePrivate+' SET MessagePosition = MessagePosition + 1 WHERE UserID=?');
        ADOQuery.Parameters.Items[0].Value:=UserID;
        ADOQuery.ExecSQL;
end;

procedure TChat.Delete(UserID : Integer);
begin
        ADOQuery.Close;
        ADOQuery.SQL.Clear;
        ADOQuery.SQL.Add('DELETE FROM '+ChatDataBasePrivate+' WHERE UserID=? AND MessagePosition>?');
        ADOQuery.Parameters.Items[0].Value:=UserID;
        ADOQuery.Parameters.Items[1].Value:=MaxPageSizeForBasePrivate;
        ADOQuery.ExecSQL;
end;

procedure TChat.Close;
begin
    ADOQuery.Close;
        ADOQuery.Free;
    ADOConnection.Close;
        ADOConnection.Free;
end;

end.

Исходный текст можна взять здесь

В следуючей статье мы расмотрим добавление пользователей и примочек к ним.