Unit Unit1;

Interface

Uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  OleCtrls, SKYPE4COMLib_TLB, StdCtrls, ExtCtrls, IdBaseComponent, IdComponent,
  IdCustomTCPServer, IdTCPServer, IdContext, Buttons;

Const Protocol = 8;

Const CallFailed = [clsFailed, clsMissed, clsRefused, clsBusy, clsCancelled];

Const MicPort = 3754;
      OutPort = 3755;

Const FileName = 'c:\test.raw';


Type
  TSoundBuff = Array [1..320] of Byte;
  TFileBuff  = Array of TSoundBuff;


Type
  TState = (ToEnabled, ToDisabled);

Type
  TForm1 = Class(TForm)
    Memo1       : TMemo;
    Panel1: TPanel;
    btnInject: TButton;
    Timer1: TTimer;
    Procedure   FormCreate(Sender: TObject);
    Procedure   SkypeCallStatus(Sender: TObject; const pCall: ICall; Status: TOleEnum);
    Procedure   SkypeAttachmentStatus(Sender: TObject; Status: TOleEnum);
    Procedure   Log (S : String);
    procedure   btnInjectClick(Sender: TObject);
    procedure   Timer1Timer(Sender: TObject);
  Private
    PacketSize  : Integer;
    Skype       : TSkype;
    Call        : ICall;
    OutServer   : TIdTCPServer;
    OutContext  : TIdContext;
    F           : File;
    FileBuff    : TFileBuff;
    FrameCount  : Integer;
    SentFrames  : Integer;
    OutFrame    : TBytes;
    Procedure   SetButtons  (State : TState);
    Procedure   OutServerConnect(AContext: TIdContext);
    Procedure   OutServerDisconnect(AContext: TIdContext);
    Procedure   OutServerExecute(AContext: TIdContext);
    Procedure   ReadRawFile;
  End;



Var
  Form1: TForm1;

Implementation

{$R *.dfm}

//------------------------------------------------------------------------------
// Link this method to Form1's OnCreate property.


Procedure TForm1.SetButtons (State : TState);

Var I : Byte;

Begin
  With Panel1 do
    For I := 0 to ControlCount-1 do
     if Controls[I]is TButton Then
      if State = ToEnabled Then Controls[I].Enabled := True
        Else Controls[I].Enabled := False;
End;


Procedure TForm1.FormCreate(Sender: TObject);

Begin
  Skype := TSkype.Create(Self);

  Skype.OnAttachmentStatus  := SkypeAttachmentStatus;
  Skype.OnCallStatus        := SkypeCallStatus;

  SetLength(OutFrame, 320);
  OutServer               := TIdTCPServer.Create(Self);
  OutServer.DefaultPort   := OutPort;
  OutServer.OnConnect     := OutServerConnect;
  OutServer.OnDisconnect  := OutServerDisconnect;
  OutServer.OnExecute     := OutServerExecute;

  OutServer.Active := True;


  Skype.Attach(Protocol, False);

  Caption := 'port injection test';

  // Prettying up the UI
  Memo1.Align := alClient;
  Memo1.ReadOnly := True;
  Memo1.Clear;
  SetButtons(ToDisabled);
End;


//------------------------------------------------------------------------------
// Fired when Skype call status changes.

Procedure TForm1.SkypeCallStatus(Sender: TObject; const pCall: ICall; Status: TOleEnum);

Begin
  if Status = clsInProgress Then
  Begin
    SetButtons(ToEnabled);
    Call := pCall;
  End
    Else Begin
      SetButtons(ToDisabled);
      Call := Nil;
      PacketSize := 0;
    End;
End;


//------------------------------------------------------------------------------
// Fired when Skype attachment status changes. Note that this handler also
// automatically attempts to reattach to the API if connection was temporarily lost

Procedure TForm1.SkypeAttachmentStatus(Sender: TObject; Status: TOleEnum);

Begin
if Status = apiAttachAvailable Then Skype.Attach(8, False);
Log(Skype.Convert.AttachmentStatusToText(Status));
End;


//------------------------------------------------------------------------------
// Log output to Memo1

Procedure TForm1.Log(S: string);

Begin
  Memo1.Lines.Add(S);
End;



Procedure TForm1.OutServerConnect(AContext: TIdContext);

Begin
  Log('Out has connected to socket ' + IntToStr(OutServer.DefaultPort));
  OutContext := AContext;
  Timer1.Enabled := True;
End;

Procedure TForm1.OutServerDisconnect(AContext: TIdContext);

Begin
  Log('Out has disconnected from socket ' + IntToStr(OutServer.DefaultPort));
End;


Procedure TForm1.ReadRawFile;

Var Bytes, Frames : Cardinal;
    I : Integer;

Begin
  if not FileExists(FileName) Then Exit;
  AssignFile(F, FileName);

  Reset(F, 1);
  Bytes := FileSize(F);
  Frames := Bytes Div 320;
  FrameCount := Frames;

  Memo1.Lines.Add('File contains ' + IntToStr(Bytes) + 'bytes; ' +  IntToStr(Frames) + ' packets');

  SetLength(FileBuff, Frames+1);
  Memo1.Lines.Add(IntToStr(SizeOf(FileBuff)));

  For I := 1 to FrameCount do
  Begin
    // Log('reading: ' + IntToStr(I));
    BlockRead(F, FileBuff[I][1], 320);
  End;

  // Memo1.Lines.Add(IntToStr(FrameCount));

  CloseFile(F);
End;

procedure TForm1.Timer1Timer(Sender: TObject);

begin
  // Log('Sending frame ' + IntToStr(SentFrames));

  Move(FileBuff[SentFrames][1], OutFrame[0], 320);

  if OutContext.Connection.Connected Then
    OutContext.Connection.IOHandler.Write(OutFrame);

  Inc(SentFrames);
  if SentFrames = FrameCount Then Timer1.Enabled := False;
end;

procedure TForm1.btnInjectClick(Sender: TObject);
begin
  Log('reading..');
  ReadRawFile;
  Log('frames: '  + IntToStr(FrameCount));
  if FrameCount = 0 Then Exit;

  SentFrames := 1;
  Log('muting mic input..');
  Call.OutputDevice[callIoDeviceTypeSoundcard] := '';

  {
  Log('output -> port');
  Call.OutputDevice[callIoDeviceTypePort] := IntToStr(OutServer.DefaultPort);
  }
  Log('input -> port');
  Call.InputDevice[callIoDeviceTypePort] := IntToStr(OutServer.DefaultPort);

end;


Procedure TForm1.OutServerExecute(AContext: TIdContext);

Begin
  // Presence of this function is required to make a socket active,
  // However, we do not need to do anything useful here.
End;

End.