//********************************************************************************************************************************
//*                                                                                                                              *
//*     TCP Server-Client Library © 3delite 2013-2015                                                                            *
//*     See TCP Server-Client Library ReadMe.txt for details                                                                     *
//*                                                                                                                              *
//* Two licenses are available for commercial usage of this component:                                                           *
//* Shareware License: €50                                                                                                       *
//* Commercial License: €250                                                                                                     *
//*                                                                                                                              *
//*     http://www.shareit.com/product.html?productid=300591476                                                                  *
//*                                                                                                                              *
//* Using the component in free programs is free.                                                                                *
//*                                                                                                                              *
//*     http://www.3delite.hu/Object%20Pascal%20Developer%20Resources/TCPServerClientLibrary.html                                *
//*                                                                                                                              *
//* For other Delphi components see the home page:                                                                               *
//*                                                                                                                              *
//*     http://www.3delite.hu/                                                                                                   *
//*                                                                                                                              *
//* If you have any questions or enquiries please mail: 3delite@3delite.hu                                                       *
//*                                                                                                                              *
//* Good coding! :)                                                                                                              *
//* 3delite                                                                                                                      *
//********************************************************************************************************************************

unit Unit1;

interface

uses
    System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
    FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Controls.Presentation, FMX.Edit, FMX.StdCtrls, FMX.Layouts,
    {$IFDEF ANDROID}
    FMX.Platform.Android,
    {$ENDIF}
    FMX.Memo, TCPServerClientLibrary, TCPClientThread, TCPLibraryClasses, BASSFunctions;

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    Memo1: TMemo;
    GroupBox2: TGroupBox;
    EditChat: TEdit;
    ButtonSend: TButton;
    ButtonConnect: TButton;
    ButtonDisconnect: TButton;
    TimerResults: TTimer;
    ImageControl1: TImageControl;
    ProgressBar: TProgressBar;
    ButtonCancelTransfer: TButton;
    TCPServerLibraryClient1: TTCPServerLibraryClient;
    ButtonSendFile: TButton;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Button1: TButton;
    Button2: TButton;
    procedure ButtonDisconnectClick(Sender: TObject);
    procedure ButtonConnectClick(Sender: TObject);
    procedure ButtonSendClick(Sender: TObject);
    procedure TimerResultsTimer(Sender: TObject);
    procedure ButtonCancelTransferClick(Sender: TObject);
    procedure ButtonSendFileClick(Sender: TObject);
    procedure TCPServerLibraryClient1ReceiveMessage(Sender: TObject; TCPClientMessage: TTCPServerMessage);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure ArrivedConnected(MessageConnected: TMessageConnected);
    procedure ArrivedLog(MessageLog: TMessageLog);
    procedure ArrivedChat(MessageChat: TMessageChat);
    procedure ArrivedTransferRequest(MessageTransferRequest: TMessageTransferRequest);
    procedure ArrivedBinary(MessageBinary: TMessageBinary);
    procedure ArrivedProgress(MessageProgress: TMessageProgress);
    procedure ArrivedCommand(MessageCommand: TMessageCommand);
  end;

var
  Form1: TForm1;
  TransferID: Integer;
  Channel: HStream;

implementation

{$R *.fmx}
{$R *.NmXhdpiPh.fmx ANDROID}

procedure TForm1.ButtonSendFileClick(Sender: TObject);
var
    //* 2 classes are available TMessageBinaryFile and TMessageBinaryMemory
    MessageBinary: TMessageBinary;
    FileName: String;
begin
    if OpenDialog1.Execute then begin
        FileName := OpenDialog1.FileName;
        //* Create and add a new file transfer object
        MessageBinary := TMessageBinaryFile.Create(FileName);
        //* Data type will be received by the client, use it to identify the transfer content
        MessageBinary.DataType := TCP_SOCKET_DATA_TYPE_FILE;
        //* File name will be also received by the client
        MessageBinary.FileName := ExtractFileName(FileName);
        //* Identify this transfer with an ID
        TCPServerLibraryClient1.TCPClientThread.LockTransferLists;
        try
            MessageBinary.ID := TCPServerLibraryClient1.TCPClientThread.GenerateUniqueTransferID;
        finally
            TCPServerLibraryClient1.TCPClientThread.UnLockTransferLists;
        end;
        //* Add it to the transfer queue
        TCPServerLibraryClient1.ActionMessageQueue.Add(MessageBinary);
    end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
    LoadBASS;
    if Assigned(BASS_Init) then begin
        if NOT BASS_SetConfig(BASS_CONFIG_DEV_BUFFER, 500) then begin
            Showmessage('Error setting BASS_CONFIG_DEV_BUFFER 500.');
        end;
        BASS_Init(- 1, 44100, 0, Handle, nil);
        if NOT BASS_SetConfig(BASS_CONFIG_BUFFER, 1500) then begin
            Showmessage('Error setting BASS_CONFIG_BUFFER 1500.');
        end;
        Channel := BASS_StreamCreate(44100, 2, 0, STREAMPROC_PUSH, nil);
        if Channel = 0 then begin
            Showmessage('Error creating BASS channel.');
        end;
    end else begin
        Showmessage('Error loading BASS.');
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
    BASS_ChannelPlay(Channel, False);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
    MainActivity.finish;
end;

procedure TForm1.ButtonCancelTransferClick(Sender: TObject);
var
    MessageTransferCancel: TMessageTransferCancel;
begin
    MessageTransferCancel := TMessageTransferCancel.Create;
    //* To cancel a transfer we need it's ID
    MessageTransferCancel.ID := TransferID;
    //* Send the cancel to the server
    TCPServerLibraryClient1.ActionMessageQueue.Add(MessageTransferCancel);
end;

procedure TForm1.ButtonConnectClick(Sender: TObject);
begin
    TCPServerLibraryClient1.LoggingOn := True;
    TCPServerLibraryClient1.Connect;
end;

procedure TForm1.ButtonDisconnectClick(Sender: TObject);
begin
    TCPServerLibraryClient1.Disconnect;
end;

procedure TForm1.ButtonSendClick(Sender: TObject);
var
    MessageChat: TMessageChat;
begin
    MessageChat := TMessageChat.Create;
    MessageChat.Text := EditChat.Text;
    //* Send this chat string to the server
    TCPServerLibraryClient1.ActionMessageQueue.Add(MessageChat);
end;

procedure TForm1.TCPServerLibraryClient1ReceiveMessage(Sender: TObject; TCPClientMessage: TTCPServerMessage);
begin
    //* Do not free TMessageTransferRequest object - it is sent back if accepted!
    if TCPClientMessage is TMessageTransferRequest then begin
        ArrivedTransferRequest(TMessageTransferRequest(TCPClientMessage));
    end else begin
        try
            //* Decide what kind of message has arrived and act accordingly
            if TCPClientMessage is TMessageConnected then begin
                ArrivedConnected(TMessageConnected(TCPClientMessage));
            end;
            if TCPClientMessage is TMessageLog then begin
                ArrivedLog(TMessageLog(TCPClientMessage));
            end;
            if TCPClientMessage is TMessageChat then begin
                ArrivedChat(TMessageChat(TCPClientMessage));
            end;
            if TCPClientMessage is TMessageBinary then begin
                ArrivedBinary(TMessageBinary(TCPClientMessage));
            end;
            if TCPClientMessage is TMessageProgress then begin
                ArrivedProgress(TMessageProgress(TCPClientMessage));
            end;
            //* If the message is a command...
            if TCPClientMessage is TMessageCommand then begin
                ArrivedCommand(TMessageCommand(TCPClientMessage));
            end;
        finally
            //* Never forget to free the object if finished with it
            FreeAndNil(TCPClientMessage);
        end;
    end;
    //* Breath
    Application.ProcessMessages;
end;

procedure TForm1.TimerResultsTimer(Sender: TObject);
begin
    //* This function needs to be called frequently it triggers the OnReceiveMessage() event if there is at least one message in the incoming message queue
    TCPServerLibraryClient1.CheckIncomingMessages;
end;

procedure TForm1.ArrivedConnected(MessageConnected: TMessageConnected);
begin
    if MessageConnected.Connected then begin
        ButtonConnect.Enabled := False;
        ButtonDisconnect.Enabled := True;
    end else begin
        ButtonConnect.Enabled := True;
        ButtonDisconnect.Enabled := False;
    end;
end;

procedure TForm1.ArrivedLog(MessageLog: TMessageLog);
begin
    //* Display the log
    Memo1.Lines.Append(MessageLog.Text);
end;

procedure TForm1.ArrivedChat(MessageChat: TMessageChat);
begin
    //* Display the string
    Memo1.Lines.Append({MessageChat.UserName + ': ' + }MessageChat.Text);
end;

procedure TForm1.ArrivedProgress(MessageProgress: TMessageProgress);
begin
    //* Display the progress, use TransferID to identify the specific transfer
    ProgressBar.Value := MessageProgress.Progress;
end;

procedure TForm1.ArrivedCommand(MessageCommand: TMessageCommand);
begin
    //* Just display the command
    Memo1.Lines.Append('Command from server: ' + IntToStr(MessageCommand.ID) + ' ' + MessageCommand.Command + ' ' + MessageCommand.Arguments);
end;

procedure TForm1.ArrivedTransferRequest(MessageTransferRequest: TMessageTransferRequest);
var
    FileName: String;
begin
    //* Accept picture and audio transfer
    if (MessageTransferRequest.DataType = TCP_SOCKET_DATA_TYPE_PICTURE)
    OR (MessageTransferRequest.DataType = 111)
    then begin
        MessageTransferRequest.Accept := True;
        TCPServerLibraryClient1.ActionMessageQueue.Add(MessageTransferRequest);
    end else
    //* Receive file transfer
    if MessageTransferRequest.DataType = TCP_SOCKET_DATA_TYPE_FILE then begin
        SaveDialog1.FileName := MessageTransferRequest.FileName;
        if SaveDialog1.Execute then begin
            FileName := SaveDialog1.FileName;
            //* If accepting multiple file transfers at the same time use ID to identify each transfer
            TransferID := MessageTransferRequest.ID;
            //* Accept and save to file
            MessageTransferRequest.Accept := True;
            if FileExists(FileName) then begin
                DeleteFile(FileName);
            end;
            MessageTransferRequest.SaveToFile := True;
            MessageTransferRequest.SaveToFileName := FileName;
            //* Notify the library that we accept this file transfer
            TCPServerLibraryClient1.ActionMessageQueue.Add(MessageTransferRequest);
        end else begin
            //* Transfer declined, free the object
            FreeAndNil(MessageTransferRequest);
        end;
    end else begin
        //* Transfer declined, free the object
        FreeAndNil(MessageTransferRequest);
    end;
end;

procedure TForm1.ArrivedBinary(MessageBinary: TMessageBinary);
begin
    //* Display the picture
    if MessageBinary.DataType = TCP_SOCKET_DATA_TYPE_PICTURE then begin
        MessageBinary.Data.Seek(0, soBeginning);
        ImageControl1.Bitmap.LoadFromStream(MessageBinary.Data);
        Memo1.Lines.Append('Received picture.');
    end;
    //* Just dispplay a notice that the file transfer finished
    if MessageBinary.DataType = TCP_SOCKET_DATA_TYPE_FILE then begin
        Memo1.Lines.Append('Received file: ' + MessageBinary.FileName);
    end;
    //* Audio
    if MessageBinary.DataType = 111 then begin
        BASS_StreamPutData(Channel, TMemoryStream(MessageBinary.Data).Memory, TMemoryStream(MessageBinary.Data).Size);
        //Memo1.Lines.Append('Received audio: ' + IntToStr(TMemoryStream(MessageBinary.Data).Size));
    end;
end;

end.

