telefoon.pas

ACM_VOIP_VCL VOIP

unit telefoon;
//http://www.mozilla.org/MPL/MPL-1.1.html


{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: telefoon.pas, released October 18, 2002.

The Initial Developer of the Original Code is Remko Weingarten
Portions created by Remko Weingarten are Copyright (C) 2002 Remko Weingarten
//All Rights Reserved.
}


interface

uses
  Windows, SysUtils, Classes, Controls, Forms,
  mmsystem, StdCtrls, Graphics, ExtCtrls, ComCtrls, NMUDP, dialogs,
  soundOut, soundIn, Messages, soundConverter, psock, mixing;

type 
  Tselfsound = procedure(var sound: pointer; var size: integer; var handled: boolean) of
  object;
type  
  TGeneralEvent = procedure(Sender: TObject; Text: string) of object;
type  
  TpingEvent = procedure(Sender: TObject; Text: string; pingisanswer: boolean;
    fromip: string; fromport: integer; Name: string) of object;
type 
  Tverbinding = (LERNOUT4, PCM8, GSM610, PCM22, PCM11, LERNOUT8);
type 
  Ttimerevent = procedure(Sender: TObject) of object;
type
  TTelefoon = class(TComponent)
  private

    factive: boolean;
    fip: string;
    fauthor: string;
    fsync: boolean;
    fmix: Taudio;
    frejected: Tgeneralevent;
    flocal: integer;
    fvolume: integer;
    fport: integer;
    nm: tnmudp;
    acmin1: Tacmin;
    fcalled: Tgeneralevent;
    fcodecerror: tgeneralevent;
    fwait: integer;
    fsoundclose: Ttimerevent;
    faccepted: tgeneralevent;
    acmout1: Tacmout;
    fverbinding: tverbinding;
    fzelf: boolean;
    Fstatus: Tgeneralevent;
    fsoundstart: Tgeneralevent;
    fselfsound: Tselfsound;
    Fverzonden: Tgeneralevent;
    Fended: Tgeneralevent;
    fbellen: boolean;
    flocalip: string;
    fauto: boolean;
    ftimer: Ttimer;
    Fanswer: boolean;
    gip: string;
    gport: integer;
    fsms: Tgeneralevent;
    gconnect: tverbinding;
    Gzelf: boolean;
    nmping: Tnmudp;
    Fpinglocal: integer;
    Fpingremote: integer;
    fnoresponce: tgeneralevent;
    Fpingevent: Tpingevent;
    fpingrespond: boolean;
    fmute: boolean;
    fbeforesoundout: Tselfsound;
    fsoundrecieved: tgeneralevent;
    Fversie: string;

    { Private declarations }
  protected
    procedure helaas(Sender: TObject);
    function getvolume: integer;
    procedure setvolume(Value: integer);
    function getwait: integer;
    procedure setwait(Value: integer);
    procedure beller(var s: string);
    procedure showbericht(s: string);
    procedure setip(const Value: string);
    procedure setauthor(const Value: string);
    procedure setversion(const Value: string);
    procedure setport(const Value: integer);
    procedure setlocalport(const Value: integer);
    procedure setremotepingport(const Value: integer);
    procedure setlocalpingport(const Value: integer);
    procedure setactive(const Value: boolean);
    procedure setbellen(const Value: boolean);
    procedure nmDataSend(Sender: TObject);
    procedure nmStatus(Sender: TComponent; status: string);
    procedure ACMIn1BufferFull(Sender: TObject; Data: Pointer;
      Size: integer);
    procedure nmDataReceived(Sender: TComponent; NumberBytes: integer;
      FromIP: string; Port: integer);
    procedure pingReceivedd4(Sender: TComponent;
      NumberBytes: integer; FromIP: string);
    procedure pingReceived(Sender: TComponent; NumberBytes: integer;
      FromIP: string; Port: integer);
    procedure NMDataReceivedd4(Sender: TComponent;
      NumberBytes: integer; FromIP: string);

    procedure start;
    procedure stop;
    procedure answer;


    { Protected declarations }
  public
    bufferdelen: integer;
    messagesize: integer;
    Fsyncfactor: integer;
    function test: integer;
    function getsoundinlevel: longint;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure sendmessage(s: string);
    procedure placecall(ip: string);
    procedure vernieuwlocal;
    procedure ping(ip, naam: string);
    procedure answerincomming;
    procedure rejectincomming;
    function getmikevolume: integer;
    { Public declarations }
    property Active: boolean read factive write setactive default False;
  published
    property Remote_IP: string read fip write setip;
    property Remote_Port: integer read fport write setport;
    property Local_Port: integer read flocal write setlocalport;
    property Connection: Tverbinding read fverbinding write fverbinding default gsm610;
    property User_Chosen_Codec: boolean read fzelf write fzelf;
    property Author_Email: string read Fauthor write setauthor;
    property Calling: boolean read fbellen write setbellen default False;
    property Adopt_Settings_Off_Caller: boolean read fauto write fauto;
    property Auto_Answer: boolean read fanswer write fanswer;
    property Local_IP: string read flocalip write flocalip;
    property Local_Ping_Port: integer read fpinglocal write setlocalpingport;
    property Remote_Ping_port: integer read fpingremote write setremotepingport;
    property Ping_Auto_Respond: boolean read fpingrespond write fpingrespond;
    property Mute: boolean read fmute write fmute;
    property Auto_synchronise: boolean read fsync write fsync;
    property OnUdpStatus: Tgeneralevent read Fstatus write Fstatus;
    property OnDataSend: Tgeneralevent read Fverzonden write Fverzonden;
    property OnCalled: tgeneralevent read fcalled write fcalled;
    property OnConnectionEnded: tgeneralevent read fended write fended;
    property OnTextMessage: tgeneralevent read fsms write fsms;
    property OnDeviceOpenError: tgeneralevent read fcodecerror write fcodecerror;
    property OnCallAccepted: tgeneralevent read faccepted write faccepted;
    property OnPinnged: Tpingevent read fpingevent write fpingevent;
    property Volume: integer read getvolume write setvolume;
    property OnAudioDeviceOpen: Tgeneralevent read fsoundstart write fsoundstart;
    property Version: string read fversie write setversion;
    property OnCallRejected: Tgeneralevent read frejected write frejected;
    property WaitForconnectionTime: integer read getwait write setwait;
    property OnNoResponce: Tgeneralevent read fnoresponce write fnoresponce;
    property OnSoundRecieved: Tgeneralevent read Fsoundrecieved write fsoundrecieved;
    property OnSelfSound: Tselfsound read fselfsound write fselfsound;
    property OnSoundClose: Ttimerevent read fsoundclose write fsoundclose;
    property OnBeforeSoundout: Tselfsound read fbeforesoundout write fbeforesoundout;
    { Published declarations }
  end;

procedure Register;

implementation

constructor Ttelefoon.Create(AOwner: TComponent);
begin
  inherited Create(aowner);
  vernieuwlocal;
  fport := 8000;
  flocalip := '';
  fmix := Taudio.Create(self);
  factive := False;
  bufferdelen := 20;
  messagesize := 150;
  fmute := False;
  fbellen := False;
  fsyncfactor := 20;
  ftimer := ttimer.Create(self);
  ftimer.Enabled := False;
  ftimer.interval := 15000;
  fwait := 15000;
  ftimer.ontimer := helaas;
  fverbinding := gsm610;
  fauthor := '[e-mail]';
  fanswer := True;
  fip := '127.0.0.1';
  flocal := 8000;
  fpinglocal := 8001;
  fpingremote := 8001;
  fsync := True;
  fauto := True;
  setversion(' ');
  nmping := Tnmudp.Create(self);
  nmping.localport := fpinglocal;
  nmping.RemotePort := fpingremote;
  nmping.RemoteHost := fip;
  nmping.ReportLevel := status_basic;
  {$IFNDEF VER120}
  nmping.OnDataReceived := pingReceived;
  {$else}
  nmping.OnDataReceived := pingReceivedd4;
  {$ENDIF}
  nm := Tnmudp.Create(self);
  nm.localport := flocal;
  nm.remotehost := fip;
  nm.remoteport := fport;
  nm.reportlevel := status_basic;
  acmin1 := Tacmin.Create(self);
  acmin1.buffersize := 100;
  acmin1.numbuffers := 4;
  setversion(' ');
  acmout1 := Tacmout.Create(self);
  acmout1.numbuffers := 4;
  acmin1.onbufferfull := ACMIn1BufferFull;
  {$IFNDEF VER120}
  nm.OnDataReceived := nmDataReceived;
  {$else}
  nm.OnDataReceived := nmDataReceivedd4;
  {$ENDIF}
  nm.onstatus := nmstatus;
  nm.ondatasend := nmdatasend;
end;

procedure Ttelefoon.vernieuwlocal;
var 
  t: tpowersock;
begin
  try
    t := tpowersock.Create(nil);
    flocalip := t.localip;
  finally
    t.Free
  end
end;


destructor Ttelefoon.Destroy;
begin
  try
    if calling then calling := False;
    if active then active := False;
  except
  end;
  ftimer.Enabled := False;
  ftimer.Free;
  acmout1.Close;
  acmin1.Close;
  acmin1.Free;
  fmix.Destroy;
  if assigned(fsoundclose) then fsoundclose(self);
  nm.Free;
  nmping.Free;
  acmout1.Free;
  inherited
end;

procedure Ttelefoon.helaas(Sender: TObject);
begin
  ftimer.Enabled := False;
  calling := False;
  if assigned(fnoresponce) then fnoresponce(Sender, 'no responce') 
  else 
    ShowMessage('No responce');
end;

  


procedure Ttelefoon.pingReceivedd4(Sender: TComponent;
  NumberBytes: integer; FromIP: string);
begin
  pingreceived(Sender, numberbytes, fromip, fport)
end;


procedure Ttelefoon.pingReceived(Sender: TComponent; NumberBytes: integer;
  FromIP: string; Port: integer);
var 
  k: Tmemorystream;
  s, naam: string;
  a: array[1..60] of char;
  i: integer;
  toevoegen: boolean;
  ip: string;
  ipadd: boolean;
  nietantwoorden: boolean;
  voegnaamtoe: boolean;
begin
  if numberbytes > 70 then exit;
  if numberbytes > 30 then nmping.ReadBuffer(a, numberbytes) 
  else 
    exit;
  s := '';
  toevoegen := False;
  nietantwoorden := False;
  i := 1;
  ipadd := False;
  ip := '';
  naam := '';
  voegnaamtoe := False;
  while i <= numberbytes do
  begin
    if a[i] = '@' then voegnaamtoe := False;
    if voegnaamtoe then naam := naam + a[i];
    if a[i] = 'I' then ipadd := True;
    if ((a[i] < '0') or (a[i] > '9')) and (a[i] <> '.') and (a[i] <> 'I') then
      ipadd := False;
    if (a[i] <> 'I') and ipadd then ip := ip + a[i];
    if (a[i] < '0') or (a[i] > '9') then 
    begin 
      toevoegen := False 
    end;
    if toevoegen then s := s + a[i];
    if a[i] = 'Q' then toevoegen := True;
    if a[i] = ';' then nietantwoorden := True;
    if a[i] = 'N' then voegnaamtoe := True;
    i := i + 1
  end;
  if assigned(fpingevent) then fpingevent(Sender, a, nietantwoorden, ip, port, naam);
  if fpingrespond and (not nietantwoorden) then
  begin
    if trim(s) <> '' then
      try
        fpingremote := StrToInt(s);
        nmping.RemotePort := StrToInt(s);
        nmping.RemoteHost := ip;
        if trim(flocalip) = '' then vernieuwlocal;
        s := 'I' + flocalip + 'P' + IntToStr(flocal) + 'V' + IntToStr(Ord(fverbinding)) +
          ';' + 'Q' + IntToStr(fpingremote);
        if factive then s := s + 'AT' 
        else 
          s := s + 'AF';
        if fanswer then s := s + 'OT' 
        else 
          s := s + 'OF';
        s := s + '@';
        for i := 1 to length(s) do a[i] := s[i];
        nmping.SendBuffer(a, 60);
      except
      end
  end;
end;








procedure Ttelefoon.NMDataReceivedd4(Sender: TComponent;
  NumberBytes: integer; FromIP: string);
begin
  nmdatareceived(Sender, numberbytes, fromip, fport)
end;


procedure Ttelefoon.nmDataReceived(Sender: TComponent; NumberBytes: integer;
  FromIP: string; Port: integer);
var 
  s: string;
  k: tmemorystream;
  p: pointer;
  groot: integer;
  h: boolean;
begin
  k := Tmemorystream.Create;
  k.Clear;
  try
    nm.ReadStream(k);
    if numberbytes = messagesize then
    begin
      setlength(s, messagesize);
      k.Read(s[1], messagesize);
      s := trim(s);
      if (trim(s)[1] <> 'I') then
      begin
        if length(s) > 2 then if (s[1] = '&') and (s[2] = '&') then Delete(s, 1,2);
        showbericht(s)
      end 
      else
      begin
        beller(s);
        if fanswer then 
        begin 
          active := True;
          sendmessage('^Connected');
          ftimer.Enabled := False 
        end;
        if assigned(fcalled) then fcalled(Sender, s);
      end
    end 
    else
    begin
      h := False;
      if assigned(fbeforesoundout) then
      begin
        getmem(p, k.size);
        move(k.memory^, p^, k.size);
        groot := k.size;
        fbeforesoundout(p, groot, h);
        if h then
          try
            acmout1.play(p, groot);
          finally
            freemem(p)
          end;
        freemem(p)
      end;

      if (not h) and ((random(1200) > fsyncfactor) or (not fsync)) then
        acmout1.Play(k.memory, k.size);
      if assigned(fsoundrecieved) then fsoundrecieved(self, fromip);
    end;
  finally
    k.Clear;
    k.Free
  end
end;


procedure Ttelefoon.start;
var 
  format: pointer;
  maxsizeformat: longint;
  F: Tacmwaveformat;
  g: tacmconvertor;
  e: Exception;
  origformat: pWaveFormatEX;
  x: integer;
  b: boolean;
  s: array[1..256] of byte;
begin
  if fzelf then
  begin
    g := Tacmconvertor.Create(self);
    b := g.chooseformat(f, False);
  end
  else
  begin
    GetMem(OrigFormat, Sizeof(TACMWaveFormat));
    x := Ord(fverbinding) + 1;
    b := True;
    case x of
      1:
        with origformat^ do 
        begin
          wformattag := 4353; //efficient l& h 4.8        1kb
          nchannels := 1;
          nsamplespersec := 8000;
          navgbytespersec := 600;
          nblockalign := 12;
          wbitspersample := 16;
          cbsize := 0;
          f.format := origformat^
        end;
      2: with OrigFormat^ do 
        begin
          wFormatTag := 1;   // pcm  8kb
          nChannels := 1;     // Mono
          nSamplesPerSec := 8000; //Low enough to strean
          nAvgBytesPerSec := 8000;
          nBlockAlign := 1;
          wbitspersample := 8;
          cbSize := 46593;
          f.Format := origformat^;
        end;
      3:
        with origformat^ do 
        begin
          wformattag := 49; // gsm 6.10 2kb
          nchannels := 1;
          nsamplespersec := 8000;
          navgbytespersec := 1625;
          nblockalign := 65;
          wbitspersample := 0;
          cbsize := 2;
          move(origformat^, s, Sizeof(TACMWaveFormat));
          s[18] := 0;
          s[19] := 64;
          s[20] := 1;
          move(s, f.format, sizeof(Tacmwaveformat));
        end;
      4:
        with origformat^ do 
        begin
          wformattag := 1; //pcm 22 (radiokwaliteit)
          nchannels := 1;
          nsamplespersec := 22050;
          navgbytespersec := 22050;
          nblockalign := 1;
          wbitspersample := 8;
          cbsize := 0;
          f.format := origformat^
        end;
      5:
        with origformat^ do 
        begin
          wformattag := 1; //pcm 11telefoonkwaliteit
          nchannels := 1;
          nsamplespersec := 11025;
          navgbytespersec := 11025;
          nblockalign := 1;
          wbitspersample := 8;
          cbsize := 0;
          f.format := origformat^
        end;
      6:
        with origformat^ do 
        begin
          wformattag := 4354; //lernout8
          nchannels := 1;
          nsamplespersec := 8000;
          navgbytespersec := 1850;
          nblockalign := 37;
          wbitspersample := 16;
          cbsize := 0;
          f.format := origformat^
        end;
    end;
    freemem(origformat)
  end;
  if b then 
  begin
    acmin1.BufferSize := trunc(f.Format.nAvgBytesPerSec / bufferdelen);

    if acmin1.buffersize <= f.format.nblockalign then
      acmin1.BufferSize := f.format.nblockalign * 2;
    if acmin1.buffersize > 1900 then acmin1.buffersize := 1900;
    if acmin1.buffersize = messagesize then acmin1.BufferSize := messagesize + 65;
    try
      ACMOut1.Open(f);
      ACMIn1.Open(f);
      if assigned(fsoundstart) then fsoundstart(self, 'soundstart');