fringer.pas

Warn you trough modem when your telephone is ringing. Useful to work with headphones. =)

unit fRinger;

interface

uses
  Windows, Forms, SysUtils, StdCtrls, Buttons, Controls, ExtCtrls, TAPILine, ImgList,
  CoolTrayIcon, Menus, Graphics, Classes, jpeg;

type
  TfrmRinger = class(TForm)
    ppmRinger: TPopupMenu;
    N2: TMenuItem;
    Exit1: TMenuItem;
    mmoLog: TMemo;
    TrayIcon: TCoolTrayIcon;
    IconList: TImageList;
    N1: TMenuItem;
    ppmPopUp: TMenuItem;
    tmrClear: TTimer;
    imgRingerIcon: TImage;
    Line: TTAPILine;
    panLog: TPanel;
    panPopup: TPanel;
    panSobre: TPanel;
    Label1: TLabel;
    lblVersao: TLabel;
    btbSobre: TBitBtn;
    mmoSobre: TMemo;
    N3: TMenuItem;
    Sobre1: TMenuItem;
    imgPopup: TImage;
    procedure Exit1Click(Sender: TObject);
    procedure MenuClick(Sender: TObject);
    procedure ppmPopUpClick(Sender: TObject);
    procedure imgPopupClick(Sender: TObject);
    procedure TrayIconDblClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure LineCallOffering(Sender: TObject);
    procedure tmrClearTimer(Sender: TObject);
    procedure btbSobreClick(Sender: TObject);
    procedure Sobre1Click(Sender: TObject);
  private
    procedure Log(Mensagem:String;ShowLog:Boolean=False);
    procedure MontaMenu;
    procedure MostraLog;
    procedure MostraPopup;
    procedure MostraSobre;
    procedure MostraApp;

    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmRinger: TfrmRinger;

implementation

{$R *.dfm}

function FileGetVersionInfo(const FileName:WideString):String;
var
  buf:     Pointer;
  bufSize,
  n:       DWORD;
  OK:      Boolean;
  pInfo:   PVSFixedFileInfo;

begin
  Result:= '';
  if Win32Platform = VER_PLATFORM_WIN32_NT then
    bufSize:= GetFileVersionInfoSizeW(PWChar(FileName), n)
  else
    bufSize:= GetFileVersionInfoSizeA(PChar(string(FileName)), n);
  if bufSize=0 then
    Exit;
  GetMem(buf, bufSize);
  try
    if Win32Platform = VER_PLATFORM_WIN32_NT then
      OK:= GetFileVersionInfoW(PWChar(FileName), 0, bufSize, buf)
    else
      OK:= GetFileVersionInfoA(PChar(string(FileName)), 0, bufSize, buf);
    if OK then
    begin
      if VerQueryValue(buf, '\', pointer(pInfo), n) then
      begin
        Result:= Format('%d.%d.%d.%d',
                        [HiWord(pInfo.dwFileVersionMS),
                        LoWord(pInfo.dwFileVersionMS),
                        HiWord(pInfo.dwFileVersionLS),
                        LoWord(pInfo.dwFileVersionLS)]);
        if (LoWord(pInfo.dwFileFlags) and 2) = 2 then
          Result := Result + ' beta';
        if (LoWord(pInfo.dwFileFlags) and 1) = 1 then
          Result := Result + ' debug';
      end;
    end;
  finally
    FreeMem(buf, bufSize);
  end;
end;

// ==============------------------

procedure TfrmRinger.MostraApp;
begin
  try
    Application.Restore;
    Application.BringToFront;
    Application.ProcessMessages;
  except
    on E: exception do
      Log('MostraApp:: '+E.Message);
  end;
end;

procedure TfrmRinger.MostraSobre;
begin
  MostraApp;
  panSobre.BringToFront;
end;

procedure TfrmRinger.MostraPopup;
begin
  MostraApp;
  panPopup.BringToFront;
end;

procedure TfrmRinger.MostraLog;
begin
  MostraApp;
  panLog.BringToFront;
end;

procedure TfrmRinger.Log(Mensagem:String;ShowLog:Boolean=False);
var
  stLog: String;
begin
  stLog := FormatDateTime('dd-mm-yyyy hh:nn:ss',Now)+' : '+Mensagem;
  mmoLog.Lines.Add(stLog);
  if ShowLog then
    MostraLog;
end;

// ----- // -----

procedure TfrmRinger.FormCreate(Sender: TObject);
begin
  lblVersao.Caption := FileGetVersionInfo(ParamStr(0));
  Caption := 'Ringer - '+lblVersao.Caption;
  TrayIcon.Hint := Caption;
  TrayIcon.Icon.Assign(imgRingerIcon.Picture.Icon);
  panLog.Align := alClient;
  panPopup.Align := alClient;
  imgPopup.Align := alClient;
  MontaMenu;
  Log('Iniciado '+Caption);
end;

procedure TfrmRinger.MontaMenu;
var
  i: Integer;
  ListTemp: TStrings;
  mnuItem: TMenuItem;

  procedure AddMenu(Text:String;Id:Integer=-1);
  begin
    mnuItem := TMenuItem.Create(ppmRinger);
    ppmRinger.Items.Insert(0,mnuItem);
    mnuItem.Caption := Text;
    if Id >= 0 then
    begin
      mnuItem.RadioItem := True;
      mnuItem.GroupIndex := 0;
      mnuItem.Tag := Id;
      mnuItem.OnClick := MenuClick;
    end;
  end;

begin
  ListTemp := TStringList.Create;
  try
    Line.FillTAPILine(ListTemp);
    if ListTemp.Count > 0 then
    begin
      AddMenu('-');
      for i := 0 to ListTemp.Count -1 do
      begin
        AddMenu(ListTemp[i],i);
      end;
      AddMenu('-');
      AddMenu('Off');
      mnuItem.RadioItem := True;
      mnuItem.GroupIndex := 0;
      mnuItem.Tag := -1;
      mnuItem.OnClick := MenuClick;
      mnuItem.Checked := True;
    end;
  finally
    ListTemp.Free;
  end;
end;

procedure TfrmRinger.Exit1Click(Sender: TObject);
begin
  Close;
end;

procedure TfrmRinger.MenuClick(Sender: TObject);
var
  inPort: Integer;
begin
  inPort := (Sender as TComponent).Tag;
  Line.Close;
  if inPort = -1 then
  begin
    Log('Monitor desligado.');
    Exit;
  end;
  try
    Line.DevIdToInitialize := inPort;
    Line.DeviceDirectAccess := False;
    Line.WaitForCall := False;
    Line.Open;
    Log('Monitorando dispositivo '+(Sender as TMenuItem).Caption);
    (Sender as TMenuItem).Checked := True;
  except
    on E: exception do
      Log('Erro, dispositivo '+(Sender as TMenuItem).Caption+' : '+E.Message,True);
  end;
end;

procedure TfrmRinger.ppmPopUpClick(Sender: TObject);
begin
  (Sender as TMenuItem).Checked := not (Sender as TMenuItem).Checked;
  if (Sender as TMenuItem).Checked then
    Log('Pop-Up ativado.')
  else
    Log('Pop-Up desativado.');
end;

procedure TfrmRinger.imgPopupClick(Sender: TObject);
begin
  Application.Minimize;
end;

procedure TfrmRinger.TrayIconDblClick(Sender: TObject);
begin
  MostraLog;
end;

procedure TfrmRinger.LineCallOffering(Sender: TObject);
begin
  Log('Telefone tocando...');
  TrayIcon.CycleIcons := True;
  if ppmPopUp.Checked then
    MostraPopup;
  tmrClear.Enabled := True;
end;

procedure TfrmRinger.tmrClearTimer(Sender: TObject);
begin
  tmrClear.Enabled := False;
  TrayIcon.CycleIcons := False;
  TrayIcon.Icon.Assign(imgRingerIcon.Picture.Icon);
  Application.Minimize;
end;


procedure TfrmRinger.btbSobreClick(Sender: TObject);
begin
  MostraLog;
end;

procedure TfrmRinger.Sobre1Click(Sender: TObject);
begin
  MostraSobre;                           
end;

end.