//********************************************************************************************************************************
//*                                                                                                                              *
//*     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

{$I TCPSCLCompilerDefines.inc}

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, {$IFDEF TCPSCL_DELPHI_XE5}FMX.StdCtrls, {$ENDIF} FMX.Forms, FMX.Dialogs, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, FMX.Edit, FMX.Layouts, FMX.Memo, TCPServerThread, TCPLibraryClasses, TCPServerClientLibrary, BASS;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    TimerMessages: TTimer;
    Button1: TButton;
    TCPServerLibraryServer1: TTCPServerLibraryServer;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Button5: TButton;
    procedure TimerMessagesTimer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure TCPServerLibraryServer1ReceiveMessage(Sender: TObject; TCPServerMessage: TTCPServerMessage);
    procedure Button5Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure ArrivedLog(MessageLog: TMessageLog);
    procedure ArrivedTransferRequest(MessageTransferRequest: TMessageTransferRequest);
    procedure ArrivedCommand(MessageCommand: TMessageCommand);
    procedure ArrivedChat(MessageChat: TMessageChat);
  end;

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

implementation

{$R *.fmx}

Uses
    UsersList;

{ TForm1 }

procedure TForm1.Button1Click(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);
        //* Transfer type can be:
        //* Asynchronous (default): multiple transfers which are asynchronous are transfered in paralell - different transfers may arrive in any order (usually smallest first)
        //* Synchronous: multiple transfers which are synchronous are transfered one by one in order added to the ActionMessageQueue - usefull for sending small data packets which are the same data stream like streaming audio
        //MessageBinary.TransferType := ttSynchronous;
        //* Add it to the transfer queue
        TCPServerLibraryServer1.ActionMessageQueue.Add(MessageBinary);
    end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
    TCPServerLibraryServer1.LoggingOn := True;
    //* Start listening for incoming connections
    TCPServerLibraryServer1.Start;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
    BASS_ChannelRemoveDSP(Channel, CastDSPHandle);
    //* Stop listening for incoming connections
    TCPServerLibraryServer1.Stop;
end;

procedure TForm1.Button4Click(Sender: TObject);
Const
    FILE_NAME = 'Pic.jpg';
var
    //* 2 classes are available TMessageBinaryFile and TMessageBinaryMemory
    MessageBinary: TMessageBinary;
begin
    //* Create and add a new data transfer object now of 'memory' type which means all the data to transfer is in memory
    MessageBinary := TMessageBinaryMemory.Create;
    //* Data type will be received by the client, use it to identify the transfer content
    MessageBinary.DataType := TCP_SOCKET_DATA_TYPE_PICTURE;
    //* File name will be also received by the client, also usable as the description, comment, etc. for the transfer
    MessageBinary.FileName := ExtractFileName(FILE_NAME);
    //* Load the data into memory
    TMemoryStream(MessageBinary.Data).LoadFromFile(FILE_NAME);
    //* Add it to the outgoing transfer queue
    TCPServerLibraryServer1.ActionMessageQueue.Add(MessageBinary);
end;


procedure DSPProcCast(handle: HDSP; channel: DWORD; buffer: Pointer; length: DWORD; user: Pointer); {$IFDEF MSWINDOWS}stdcall{$ELSE}cdecl{$ENDIF};
var
    //* 2 classes are available TMessageBinaryFile and TMessageBinaryMemory
    MessageBinary: TMessageBinaryMemory;
begin
    //* Create and add a new data transfer object now of 'memory' type which means all the data to transfer is in memory
    MessageBinary := TMessageBinaryMemory.Create;
    //* Data type will be received by the client, use it to identify the transfer content
    MessageBinary.DataType := 111;
    MessageBinary.ID := 5000;
    MessageBinary.FileName := 'AUDIO';
    //* Load the data into memory
    TMemoryStream(MessageBinary.Data).Write(buffer^, length);
    TMemoryStream(MessageBinary.Data).Seek(0, soBeginning);
    MessageBinary.TransferType := ttSynchronous;
    MessageBinary.RequireAgreement := raFalse;
    //* Add it to the outgoing transfer queue
    Form1.TCPServerLibraryServer1.ActionMessageQueue.Add(MessageBinary);
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
    Channel := BASS_StreamCreateFile(False, PChar('Test.mp3'), 0, 0, BASS_UNICODE);
    CastDSPHandle := BASS_ChannelSetDSP(Channel, DSPProcCast, nil, 0);
    BASS_ChannelPlay(Channel, True);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
    Login: TLogin;
begin
    BASS_Init(- 1, 44100, 0, Handle, nil);
    //* Add a user so we can log in
    Login := TLogin.Create;
    Login.Name := '3delite';
    Login.PassWord := 'TestPassword';
    TCPServerLibraryServer1.LoginList.Add(Login);
end;

procedure TForm1.TCPServerLibraryServer1ReceiveMessage(Sender: TObject; TCPServerMessage: TTCPServerMessage);
begin
    //* Do not free TMessageTransferRequest object - it is sent back if accepted!
    if TCPServerMessage is TMessageTransferRequest then begin
        ArrivedTransferRequest(TMessageTransferRequest(TCPServerMessage));
    end else begin
        try
            //* If the message is a log class...
            if TCPServerMessage is TMessageLog then begin
                ArrivedLog(TMessageLog(TCPServerMessage));
            end;
            //* If the message is a command...
            if TCPServerMessage is TMessageCommand then begin
                ArrivedCommand(TMessageCommand(TCPServerMessage));
            end;
            //* If the message is a chat...
            if TCPServerMessage is TMessageChat then begin
                ArrivedChat(TMessageChat(TCPServerMessage));
            end;
        finally
            //* Never forget to free all the objects
            FreeAndNil(TCPServerMessage);
        end;
    end;
end;

procedure TForm1.TimerMessagesTimer(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
    TCPServerLibraryServer1.CheckIncomingMessages;
end;

procedure TForm1.ArrivedChat(MessageChat: TMessageChat);
begin
    //* Just display the log
    Memo1.Lines.Append(MessageChat.UserName + ': ' + MessageChat.Text);
end;

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

procedure TForm1.ArrivedTransferRequest(MessageTransferRequest: TMessageTransferRequest);
var
    FileName: String;
begin
    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 all and if file transfer 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 accepted this file transfer
            TCPServerLibraryServer1.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.ArrivedCommand(MessageCommand: TMessageCommand);
begin
    //* Just display the command
    Memo1.Lines.Append('Command from client: ' + MessageCommand.Client.UserName + ' ' + IntToStr(MessageCommand.ID) + ' ' + MessageCommand.Command + ' ' + MessageCommand.Arguments);
end;

end.
