Telefondan Telefona Bas Konuş Tarzı Chat Programı

[Jakarta2]

Server Tarafı:

unit ServerUnit1;

interface

uses
 System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
 FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Memo.Types,
 IdBaseComponent, IdComponent, IdUDPBase, IdUDPServer, FMX.Media,
 FMX.Controls.Presentation, FMX.ScrollBox, FMX.Memo, IdGlobal, IdSocketHandle,
 system.Generics.Collections, FMX.StdCtrls, FMX.Edit, FMX.Objects;

type
 TDataTransRec = Record
 Block : TBytes;
 PeerIp :String;
 IdData : Byte;
 Constructor Create (aData:TidBytes; Const aPeerIp : String);
 Function Info : String;
 Function Tostring : String;
 End;


 TVoiceserver = class(TForm)
   Memo1: TMemo;
   MediaPlayer1: TMediaPlayer;
   IdUDPServer1: TIdUDPServer;
   Panel1: TPanel;
   Image1: TImage;
   procedure FormCreate(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
   procedure IdUDPServer1UDPRead(AThread: TIdUDPListenerThread;
     const AData: TIdBytes; ABinding: TIdSocketHandle);
   procedure Image1Click(Sender: TObject);
 private
   { Private declarations }
 public
   liste : TList<TDataTransRec>;
   StartPos:Integer;
   Procedure DosyaKaydet(Const aStartpos : integer);
   Function strdizin:String;
 end;

var
 Voiceserver: TVoiceserver;

implementation

uses ioutils, Math;

{$R *.fmx}

procedure TVoiceserver.DosyaKaydet(const aStartpos: integer);
var
A:Integer;
F:String;
M:TMemoryStream;
begin
A := aStartpos+1;
F := strdizin+Liste[A].Tostring;
A := A + 1;
if (Liste[A].Tostring = 'StartData') and (Liste[A].IdData = 3) then
Begin
  M := TMemoryStream.Create;
  Repeat
    inc(A);
    if Liste[A].IdData = 0 then M.Write(Liste[A].Block, Length(Liste[A].Block));
  Until Liste[A].IdData = 4 ;
  M.Position := 0;
  M.SaveToFile(F);
  M.Free;
  Liste.Clear;
  MediaPlayer1.FileName := F;
  MediaPlayer1.Play;
End;
end;

procedure TVoiceserver.FormCreate(Sender: TObject);
begin
Liste :=  TList<TDataTransRec>.Create;
end;

procedure TVoiceserver.FormDestroy(Sender: TObject);
begin
FreeAndNil(Liste);
end;

procedure TVoiceserver.IdUDPServer1UDPRead(AThread: TIdUDPListenerThread;
 const AData: TIdBytes; ABinding: TIdSocketHandle);
 var w:TDataTransRec;
 S: String;
begin
W := TDataTransRec.Create(AData, ABinding.PeerIp);
Liste.Add(W);
S := W.Info;
if W.IdData = 1 then StartPos := Liste.Count - 1;
if W.IdData = 4 then DosyaKaydet(StartPos);
if S <> '' then Memo1.Lines.Add(S);
end;

procedure TVoiceserver.Image1Click(Sender: TObject);
begin
 close;
end;


procedure WorkArrays(var aWorking: array of integer);
begin
 if High(aWorking) >= 0 then
   aWorking[0] := 1;
 if High(aWorking) >= 3 then
   aWorking[3] := 5;
end;


function TVoiceserver.strdizin: String;
begin
{$IFDEF ANDROID}
 Result := TPath.GetHomePath;
{$ELSE}
 Result := TPath.GetHomePath + TPath.DirectorySeparatorChar + 'Unitech';
 ForceDirectories(Result);
{$ENDIF}
 Result := Result + TPath.DirectorySeparatorChar;
end;

{ TDataTransRec }

constructor TDataTransRec.Create(aData: TidBytes; const aPeerIp: String);
var s:String;
begin
PeerIp := aPeerIp;
SetLength(Block, Length(aData));
System.Move(aData[0],Block[0],Length(aData));
S := ToString;
Iddata := 0;
if Pos ('StartFile', S) > 0 then IdData := 1;
if Pos ('StartData', S) > 0 then IdData := 3;
if Pos ('EndData', S) > 0 then IdData := 4;
end;

function TDataTransRec.Info: String;
begin
Result := ToString;
if (Pos ('StartFile', Result) > 0) or
   (Pos ('StartData', Result) > 0) or
   (Pos ('EndData', Result) > 0) then
   Result := PeerIp + '==>' + Result else
   Result := '';
end;

function TDataTransRec.Tostring: String;
var A : integer;
begin
 for a := 0 to Length(Block)-1 do Result := Result + Char(Block[A]);
end;

end.

Bu da Client Tarafı

unit Mobileunit;

interface

uses
 System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
 FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Ani,
 FMX.Objects, FMX.Media, IdBaseComponent, IdComponent, IdUDPBase, IdUDPClient,
 MobilePermissions.Model.Signature, MobilePermissions.Model.Dangerous,
 MobilePermissions.Model.Standard, MobilePermissions.Component, FMX.Layouts,
 FMX.Controls.Presentation, FMX.StdCtrls, FMX.Edit;

type
 TForm1 = class(TForm)
   Rectangle1: TRectangle;
   FloatAnimation1: TFloatAnimation;
   MediaPlayer1: TMediaPlayer;
   IdUDPClient1: TIdUDPClient;
   MobilePermissions1: TMobilePermissions;
   Layout1: TLayout;
   Panel1: TPanel;
   Edit1: TEdit;
   Button1: TButton;
   Edit2: TEdit;
   Image1: TImage;
   Panel2: TPanel;
   GridPanelLayout1: TGridPanelLayout;
   procedure Rectangle1Click(Sender: TObject);
   procedure FloatAnimation1Finish(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure Button1Click(Sender: TObject);
   procedure Image1Click(Sender: TObject);
   procedure FormShow(Sender: TObject);
 private
   { Private declarations }
 public
   Micro : TAudioCaptureDevice;
   Index : Integer;
   Procedure StartRec;
   Function strdizin : String;
   Function FileName : String;
 end;

var
 Form1: TForm1;
 ipno :string;

implementation

uses IdGlobal, IOUtils,FMX.ZDeviceInfo;

{$R *.fmx}

function TForm1.FileName: String;
begin
 index := index + 1;
 Result := Format('Test%u.mp3', [index]);
 Result := strdizin + Result;
end;

procedure TForm1.FloatAnimation1Finish(Sender: TObject);
begin
 StartRec;
end;

procedure TForm1.FormShow(Sender: TObject);
var
 di: TZDeviceInfo;
begin
 di := TZDeviceInfo.Create;
 try
   edit1.Text := di.IPAddress;
 finally
   di.Free;
 end;
end;

procedure TForm1.Image1Click(Sender: TObject);
begin
Close;
end;

procedure TForm1.Rectangle1Click(Sender: TObject);
begin
 if rectangle1.Fill.Color <> TAlphaColors.Red then
 Begin
   rectangle1.Fill.Color := TAlphaColors.Red;
   StartRec;
 End
 else rectangle1.Fill.Color := TAlphaColors.Chartreuse;
 Rectangle1.Repaint;
end;

procedure TForm1.StartRec;
var
M : TMemoryStream;
K : TidBytes;
B : TBytes;
A,L : Integer;
begin
if Micro.State = TCaptureDeviceState.Capturing then
Begin
 Micro.StopCapture;
 M := TMemoryStream.Create;
 if FileExists(Micro.FileName) then
 begin
   M.LoadFromFile(Micro.FileName);
   IdUDPClient1.Send('StartFile', IndyTextEncoding_Utf8);
   IdUDPClient1.Send(ExtractFileName(Micro.FileName), IndyTextEncoding_Utf8);
   IdUDPClient1.Send('StartData', IndyTextEncoding_Utf8);
   M.Position := 0;
   L := 80;
   SetLength(K,L);
   SetLength(B,L);
   While M.Read(B,L) > 0 do
   begin
     for A := 0 to L-1  do K[A]:=B[A];
     with IdUDPClient1 do SendBuffer(Host,Port,K);
     for A := 0 to L-1  do B[A]:=0;
   end;
   IdUDPClient1.Send('EndData', IndyTextEncoding_Utf8);
 end;
End;
if Rectangle1.Fill.Color <> TAlphaColors.Red  then Exit;
Micro.FileName := FileName;
Micro.StartCapture;
FloatAnimation1.Start;
end;

function TForm1.strdizin: String;
begin
{$IFDEF ANDROID}
 Result := TPath.GetHomePath;
{$ELSE}
 Result := TPath.GetHomePath + TPath.DirectorySeparatorChar + 'Unitech';
 ForceDirectories(Result);
{$ENDIF}
 Result := Result + TPath.DirectorySeparatorChar;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 IdUDPClient1.Host := edit2.text;
 IdUDPClient1.Port := 5556;
 MobilePermissions1.Dangerous.RecordAudio := True;
 MobilePermissions1.Apply;
 Micro := TCaptureDeviceManager.Current.DefaultAudioCaptureDevice;
 Rectangle1.Enabled := Assigned(Micro);
 Index := 0;
end;


end.

Bilgisayar server telefon client olarak çalıştığında dosya telefonda oluşturulup bilgisayara gönderiliyor. Hiçbir sorun yok. Fakat server telefon client'da başka bir telefon olduğunda dosya clientda oluşturuluyor. server olan telefonda Start File ve Start Data memo'ya ekleniyor. Ama dosya server telefonda oluşmuyor. Dosya boyutu 7.34 kb büyüklüğünden olduğunu sanmıyorum. Neyi atlıyorum?