www.pudn.com > VoiceModem接口使用源码.zip > MsgVoc.pas
unit MsgVoc;
{Delphi 3.0 Component TMsgVoc 1.1 - written by Guido Giorgetti - Aug 98}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, ComDrv32;
type TMsgVocStatus = (stGoInit,stWaitInit,stInit,
stGoDial,stWaitDial,stDial,
stGoConn,stWaitConn,stConn,
stGoTX,stWaitTX,stTX,
stGoRX,stWaitRX,stRX,
stGoEndTX,stWaitEndTX,stEndTX,
stGoEndRX,stWaitEndRX,stEndRX,
stGoDisc,stWaitDisc,stDisc);
const MAXRXCHARS = 4096;
const MAXTXCHARS = 8192;
type
TMsgVocDTMFDataEvent = procedure( Sender: TObject; DTMF: Char ) of object;
TMsgVocOnRingDataEvent = procedure( Sender: TObject) of object;
TMsgVocPlayedDataEvent = procedure( Sender: TObject) of object;
TMsgVocOnConnDataEvent = procedure( Sender: TObject) of object;
TMsgVocOnInitDataEvent = procedure( Sender: TObject) of object;
TMsgVocOnTXDataEvent = procedure( Sender: TObject) of object;
TMsgVocOnEndTXDataEvent = procedure( Sender: TObject) of object;
TMsgVocOnRXDataEvent = procedure( Sender: TObject) of object;
TMsgVocOnEndRXDataEvent = procedure( Sender: TObject) of object;
TMsgVoc = class(TComponent)
private
{ Private declarations }
function IsDTMFCode(dtmf : Char) : Boolean;
function MemPos(stringa , str_in: PChar; maxchars : Integer) : Integer;
protected
{ Protected declarations }
FActive : Boolean;
FCountReps : Integer;
FLastingTime : Integer;
FLastingCounter : Integer;
FPollingTime : Integer;
FMsgVocStatus : TMsgVocStatus;
FComPortNumber : TComPortNumber;
FComPortBaudRate : TComPortBaudRate;
FDialNum,FInitString,FConnString,FTXString,FRXString: string;
FDiscString,FPlayFile,FRecFile : string;
FModemDialog : string;
FFileStream : TFileStream;
FRxChars : array[0..MAXRXCHARS-1] of Char;
FBytesInRxChars : Integer;
FTxChars : array[0..MAXTXCHARS-1] of Char;
FMsgVocDTMF : TMsgVocDTMFDataEvent; // Event to raise on DTMF receipt
FMsgVocOnRing : TMsgVocOnRingDataEvent; // Event to raise on RING received
FMsgVocPlayed : TMsgVocPlayedDataEvent; // Event to raise on file played
FMsgVocOnConn : TMsgVocOnConnDataEvent; // Event to raise when the modem goes into Command Voice stauts
FMsgVocOnInit : TMsgVocOnInitDataEvent; // Event to raise after the modem has been initialized
FMsgVocOnTX : TMsgVocOnTXDataEvent; // Event to raise when the modem goes into Voice transmit
FMsgVocOnEndTX: TMsgVocOnEndTXDataEvent; // Event to raise when the modem ends voice transmit
FMsgVocOnRX : TMsgVocOnRXDataEvent; // Event to raise when the modem goes into Voice receive
FMsgVocOnEndRX: TMsgVocOnEndRXDataEvent; // Event to raise when the modem ends voice receive
InternalTimer : TTimer;
FTries : Integer;
procedure SetActive(Value :Boolean);
procedure SetLastingTime(Value :Integer);
procedure SetPollingTime(Value :Integer);
procedure SetComPortNumber(Value : TComPortNumber);
procedure SetComPortBaudRate(Value : TComPortBaudRate);
procedure PlayingTimer(Sender : TObject);
procedure SetPlayFile(Value : string);
procedure SetRecFile(Value : string);
procedure SetInitString(Value : string);
procedure SetDialNum(Value : string);
procedure SetConnString(Value : string);
procedure SetTXString(Value : string);
procedure SetRXString(Value : string);
procedure SetDiscString(Value : string);
procedure ReceiveData(Sender : TObject; DataPtr: pointer; DataSize: integer);
public
{ Public declarations }
constructor Create( AOwner: TComponent ); override;
destructor Destroy; override;
published
{ Published declarations }
property Active :Boolean read FActive ;
property PollingTime :Integer read FPollingTime write SetPollingTime default 1000;
property LastingTime :Integer read FLastingTime write SetLastingTime default 10000;
property ComPortNumber :TComPortNumber read FComPortNumber write SetComPortNumber;
property ComPortBaudRate :TComPortBaudRate read FComPortBaudRate write SetComPortBaudRate ;
property CounterTime : Integer read FLastingCounter default 10000;
property RecFile : string read FRecFile write SetRecFile;
property InitString : string read FInitString write SetInitString;
property DialNum : string read FDialNum write SetDialNum;
property ConnString : string read FConnString write SetConnString;
property DiscString : string read FDiscString write SetDiscString;
property ModemDialog : string read FModemDialog;
procedure GoInit;
procedure GoDialConn;
procedure GoConn;
procedure GoTX;
procedure GoEndTX;
procedure GoRX;
procedure GoEndRX;
procedure GoDisc;
procedure Play(filename : string; numreps: Integer);
function GetStatusString : string;
function GetStatus : TMsgVocStatus;
// Event to raise when there a DTMF is received
property OnDTMF: TMsgVocDTMFDataEvent read FMsgVocDTMF write FMsgVocDTMF;
// Event to raise on RING
property OnRing: TMsgVocOnRingDataEvent read FMsgVocOnRing write FMsgVocOnRing;
// Event to raise when there a file is played
property OnPlayed: TMsgVocPlayedDataEvent read FMsgVocPlayed write FMsgVocPlayed;
// Event to raise when the modem goes into 'Command Voice' status
property OnInit: TMsgVocOnInitDataEvent read FMsgVocOnInit write FMsgVocOnInit;
// Event to raise when the modem goes into 'Voice Playing' status
property OnConn: TMsgVocOnConnDataEvent read FMsgVocOnConn write FMsgVocOnConn;
// Event to raise when the modem goes into 'Voice Playing' status
property OnTX: TMsgVocOnTXDataEvent read FMsgVocOnTX write FMsgVocOnTX;
// Event to raise when the modem stops 'Voice Playing'
property OnEndTX: TMsgVocOnEndTXDataEvent read FMsgVocOnEndTX write FMsgVocOnEndTX;
// Event to raise when the modem goes into 'Voice Recording' status
property OnRX: TMsgVocOnRXDataEvent read FMsgVocOnRX write FMsgVocOnRX;
// Event to raise when the modem stops 'Voice Recording'
property OnEndRX: TMsgVocOnEndRXDataEvent read FMsgVocOnEndRX write FMsgVocOnEndRX;
end;
procedure Register;
implementation
var
CPDModem : TCommPortDriver;
constructor TMsgVoc.Create( AOwner: TComponent );
begin
inherited Create( AOwner );
// Creates CPDModem
CPDModem := TCommPortDriver.Create(Self);
CPDModem.ComPortHwHandshaking := hhRTSCTS;
// Initialize to default values
FActive := False; {not active}
FCountReps := 1 ;
FLastingTime := 10000; {msec}
FPollingTime := 200; {msec}
InternalTimer := TTimer.Create(Self);
InternalTimer.OnTimer := PlayingTimer;
InternalTimer.Enabled := False;
FMSgVocStatus := stDisc;
FMsgVocDTMF := nil; // no data handler
end;
destructor TMsgVoc.Destroy;
begin
inherited Destroy;
end;
procedure TMSgVoc.SetActive(Value : Boolean);
begin
FActive := Value;
if FActive then
begin
if CPDModem <> nil then begin
CPDModem.Connect;
CPDModem.OnReceiveData := ReceiveData;
FMSgVocStatus := stDisc;
InternalTimer.Enabled := True;
InternalTimer.Interval := FPollingTime;
FLastingCounter := FLastingTime;
end;
end
else begin
FMSgVocStatus := stDisc;
InternalTimer.Enabled := False;
FFileStream.Free;
FFileStream := nil;
end;
FBytesInRxChars := 0; {azzera il contatore dei bytes da interpretare}
end;
procedure TMSgVoc.SetPollingTime(Value : Integer);
begin
if FMsgVocStatus = stDisc then
FPollingTime := Value;
end;
procedure TMSgVoc.SetLastingTime(Value : Integer);
begin
if FMsgVocStatus = stDisc then
FLastingTime := Value;
end;
procedure TMSgVoc.SetComportNumber(Value : TComPortNumber);
begin
if FMsgVocStatus = stDisc then begin
CPDModem.ComPort := Value;
FComPortNumber := CPDModem.ComPort;
end;
end;
procedure TMSgVoc.SetComportBaudRate(Value : TComPortBaudRate);
begin
if FMsgVocStatus = stDisc then begin
CPDModem.ComPortSpeed := Value;
FComPortBaudRate := CPDModem.ComPortSpeed;
end;
end;
procedure TMsgVoc.PlayingTimer(Sender : TObject);
var nc : Integer;
i,mp : Integer;
begin
if FLastingTime > 0 then begin
FlastingCounter := FLastingCounter - FPollingTime;
if FLastingCounter <= 0 then
begin
GoDisc; {disconnette}
// SetActive(False); {altrimenti ferma la riproduzione}
end;
end;
{Finite State Sequential Machine to handle all the phases of
connection, playing, recording and disconnecting }
case FMSgVocStatus of
stGoInit: begin
{sends the init modem string}
FRxChars := '';
CPDModem.FlushBuffers(True,True);
CPDModem.SendString('at' + FInitString + CHR(13));
FMsgVocStatus := stWaitInit;
FTries := 8;
end;
stWaitInit: begin
{waits the answer from the modem}
if MemPos(FRxChars,'OK',FBytesInRxChars) >= 0 then begin
FMsgVocStatus := stInit;
if Assigned(FMsgVocOnInit) then
FMsgVocOnInit( Self);//raises the event OnInit
end else if FTries = 0 then
FMsgVocStatus := stGoDisc
else
dec(FTries);
end;
stInit: begin
end;
stGoDial: begin
{sends string of dialing}
FBytesInRxChars := 0;
CPDModem.FlushBuffers(True,True);
CPDModem.SendString('at' + ' dt' + FDialNum + ';' + CHR(13));
FMsgVocStatus := stWaitDial;
FTries := 128;
end;
stWaitDial: begin
{attesa messaggio di OK dal modem}
if MemPos(FRxChars,'OK',FBytesInRxChars) >= 0 then
FMsgVocStatus := stDial
else if FTries = 0 then
FMsgVocStatus := stGoDisc
else
dec(FTries);
end;
stDial: begin
FMsgVocStatus := stGoConn;
end;
stGoConn: begin
{send ConnString}
FBytesInRxChars := 0;
CPDModem.FlushBuffers(True,True);
CPDModem.SendString('at' + FConnString + CHR(13));
FMsgVocStatus := stWaitConn;
FTries := 12;
end;
stWaitConn: begin
{waits VCON from the modem}
if MemPos(FRxChars,'VCON',FBytesInRxChars) >= 0 then begin
FMsgVocStatus := stConn;
if Assigned(FMsgVocOnConn) then
FMsgVocOnConn( Self);//raises the event OnConn
end else if FTries = 0 then
FMsgVocStatus := stGoDisc
else
dec(FTries);
end;
stConn: begin
end;
stGoTX: begin
{send TXString}
FBytesInRxChars := 0;
CPDModem.FlushBuffers(True,True);
CPDModem.SendString('at#VTX' + CHR(13));
FMsgVocStatus := stWaitTX;
FTries := 24;
end;
stWaitTX: begin
{attesa messaggio di CONNECT dal modem}
if MemPos(FRxChars,'CONNECT',FBytesInRxChars) >= 0 then begin
FMsgVocStatus := stTX;
if Assigned(FMsgVocOnTX) then
FMsgVocOnTX( Self);//raises the event OnTX
end
else if FTries = 0 then
FMsgVocStatus := stGoDisc
else
dec(FTries);
end;
stTX: begin
if FFileStream <> nil then begin
if FFileStream.Position < FFileStream.Size then
begin
nc := CPDModem.OutFreeSpace;
if MAXTXCHARS < nc then
nc := MAXTXCHARS;
nc := FFileStream.Read(FTxChars,nc);
CPDModem.SendData(@FTxChars,nc);
end
else begin
dec(FCountReps);
if FCountReps <= 0 then begin
if Assigned(FMsgVocPlayed) then
FMsgVocPlayed( Self);//raises the event OnPlayed
FFileStream.Free;
FFileStream := nil;
end else
FFileStream.Seek(0,soFromBeginning);
end;
end;
end;
stGoEndTX: begin
{end of playing}
FBytesInRxChars := 0;
CPDModem.FlushBuffers(True,True);
CPDModem.SendString(CHR(16) + CHR(3));{DLE + ETX}
FMsgVocStatus := stWaitEndTX;
FTries := 12;
end;
stWaitEndTX: begin
{attesa messaggio di CONNECT dal modem}
if MemPos(FRxChars,'VCON',FBytesInRxChars) >= 0 then begin
FMsgVocStatus := stEndTX;
if Assigned(FMsgVocOnEndTX) then
FMsgVocOnEndTX( Self);//raises the event OnEndTX
end
else if FTries = 0 then
FMsgVocStatus := stGoDisc
else
dec(FTries);
end;
stEndTX: begin
FMsgVocStatus := stGoConn;
end;
stGoRX: begin
//sends string of init recording
FBytesInRxChars := 0;
CPDModem.FlushBuffers(True,True);
CPDModem.SendString('at #VRX' + CHR(13));
FMsgVocStatus := stWaitRX;
FTries := 2;
end;
stWaitRX: begin
//attesa messaggio di CONNECT dal modem
mp := MemPos(FRxChars,'CONNECT',FBytesInRxChars) ;
if mp >=0 then begin
FMsgVocStatus := stRX;
if Assigned(FMsgVocOnRX) then
FMsgVocOnRX( Self);//raises the event OnRX
for i := 0 to FBytesInRxChars do begin
FRxChars[i] := FRxChars[mp+9+i];// cuts CONNECT #13 #10 away
end; // adjust the number of bytes in FRxChars
FBytesInRxChars := FBytesInRxChars - mp - 9;
end
else if FTries = 0 then
FMsgVocStatus := stGoDisc
else
dec(FTries);
end;
stRX: begin
//writes the sampled voice to the file
FFileStream.Write(FRxChars,FBytesInRxChars);
FBytesInRxChars := 0;
end;
stGoEndRX: begin
//writes the sampled voice to the file
FFileStream.Write(FRxChars,FBytesInRxChars);
FBytesInRxChars := 0;
//sends string of end recording
CPDModem.SendString(CHR(16) );//DLE
FMsgVocStatus := stWaitEndRX;
FTries := 48;
end;
stWaitEndRX: begin
//attesa messaggio di VCON dal modem
mp := MemPos(FRxChars,'VCON',FBytesInRxChars);
if mp >=0 then begin
FMsgVocStatus := stEndRX;
if Assigned(FMsgVocOnEndRX) then
FMsgVocOnEndRX( Self);//raises the event OnEndRX
//writes the sampled voice to the file excluding #16 #3 #13 #10 V C O N #13 #10
FFileStream.Write(FRxChars,mp-4);
FFileStream.Free;
FFileStream := nil;
FBytesInRxChars := 0;
end else if FTries = 0 then begin
FMsgVocStatus := stGoDisc;
FFileStream.Free;
FFileStream := nil;
end else begin
dec(FTries);
//writes the sampled voice, still received, to the file
FFileStream.Write(FRxChars,FBytesInRxChars);
FBytesInRxChars := 0;
end
end;
stEndRX: begin
FMsgVocStatus := stGoConn;
end;
stGoDisc: begin
FBytesInRxChars := 0;
CPDModem.FlushBuffers(True,True);
CPDModem.SendString('at' + FDiscString + CHR(13));
FMsgVocStatus := stWaitDisc;
FTries := 8;
end;
stWaitDisc: begin
{attesa messaggio OK dal modem}
if MemPos(FRxChars,'OK',FBytesInRxChars) >= 0 then
FMsgVocStatus := stDisc
else if FTries = 0 then
FMsgVocStatus := stDisc
else
dec(FTries);
end;
stDisc: begin
CPDModem.SendString('ath0' + CHR(13));
SetActive(False); {ferma la riproduzione}
end;
end; {of case}
end;
procedure TMSgVoc.SetPlayFile(Value : string);
begin
if ( (FFileStream = nil)) then begin
FPlayFile := Value;
try
FFileStream := TFileStream.Create(FPlayFile,fmOpenRead);
finally
end;
end;
end;
procedure TMSgVoc.SetRecFile(Value : string);
begin
if ( (FFileStream = nil)) then begin
FRecFile := Value;
try
FFileStream := TFileStream.Create(FRecFile,fmCreate);
finally
end;
end;
end;
procedure TMSgVoc.SetInitString(Value : string);
begin
if FMsgVocStatus = stDisc then
FInitString := Value;
end;
procedure TMSgVoc.SetDialNum(Value : string);
begin
if FMsgVocStatus = stDisc then
FDialNum := Value;
end;
procedure TMSgVoc.SetConnString(Value : string);
begin
if FMsgVocStatus = stDisc then
FConnString := Value;
end;
procedure TMSgVoc.SetTXString(Value : string);
begin
if FMsgVocStatus = stDisc then
FTXString := Value;
end;
procedure TMSgVoc.SetRXString(Value : string);
begin
if FMsgVocStatus = stDisc then
FRXString := Value;
end;
procedure TMSgVoc.SetDiscString(Value : string);
begin
if FMsgVocStatus = stDisc then
FDiscString := Value;
end;
procedure TMSgVoc.GoInit;
begin
if FMsgVocStatus = stDisc then begin
SetActive(True);
FMsgVocStatus := stGoInit;
end;
end;
procedure TMSgVoc.GoDialConn;
begin
if FMsgVocStatus = stInit then begin
FMsgVocStatus := stGoDial;
end;
end;
procedure TMSgVoc.GoConn;
begin
if FMsgVocStatus = stInit then begin
// SetActive(True);
FMsgVocStatus := stGoConn;
end;
end;
procedure TMSgVoc.GoRX;
begin
SetActive(True);
FMsgVocStatus := stGoRX;
end;
procedure TMSgVoc.GoEndRX;
begin
if FMsgVocStatus = stRX then begin
FMsgVocStatus := stGoEndRX;
end;
end;
procedure TMSgVoc.GoTX;
begin
if FMsgVocStatus = stConn then begin
FMsgVocStatus := stGoTX;
end;
end;
procedure TMSgVoc.GoEndTX;
begin
if FMsgVocStatus = stTX then begin
FMsgVocStatus := stGoEndTX;
end;
end;
procedure TMSgVoc.GoDisc;
begin
if FMsgVocStatus = stTX then begin
FMsgVocStatus := stGoEndTX;
end else begin
SetActive(True);
FMsgVocStatus := stGoDisc;
end;
end;
function TMsgVoc.GetStatusString;
begin
case FMsgVocStatus of
stGoInit : GetStatusString := 'GoInitModem';
stWaitInit : GetStatusString := 'WaitInitModem';
stInit : GetStatusString := 'InitModem';
stGoDial : GetStatusString := 'GoDial';
stWaitDial : GetStatusString := 'WaitDialling';
stDial : GetStatusString := 'Dialled';
stGoConn : GetStatusString := 'GoConn';
stWaitConn : GetStatusString := 'WaitConn';
stConn : GetStatusString := 'Conn';
stGoTX : GetStatusString := 'GoTX';
stWaitTX : GetStatusString := 'WaitTX';
stTX : GetStatusString := 'TX';
stGoRX : GetStatusString := 'GoRX';
stWaitRX : GetStatusString := 'WaitRX';
stRX : GetStatusString := 'RX';
stGoEndTX : GetStatusString := 'GoEndTX';
stWaitEndTX : GetStatusString := 'WaitEndTX';
stEndTX : GetStatusString := 'EndTX';
stGoEndRX : GetStatusString := 'GoEndRX';
stWaitEndRX : GetStatusString := 'WaitEndRX';
stEndRX : GetStatusString := 'EndRX';
stGoDisc : GetStatusString := 'GoDisc';
stWaitDisc : GetStatusString := 'WaitDisc';
stDisc : GetStatusString := 'Disc';
end;
end;
function TMsgVoc.GetStatus;
begin
result := FMsgVocStatus;
end;
procedure TMsgVoc.ReceiveData(Sender : TObject; DataPtr: pointer; DataSize: integer);
var p: pchar;
begin
// Parse incoming text
p := DataPtr;
while DataSize > 0 do
begin
if(Length(FModemDialog)>=255) then begin
Delete(FModemDialog,1,1);
end;
if ((p^ = CHR(16)) and (IsDTMFCode((p+1)^)) and (Assigned(FMsgVocDTMF))and
(not (FMSgVocStatus = stWaitRX )) and
(not (FMSgVocStatus = stRX )) and
(not (FMSgVocStatus = stGoEndRX )) and
(not (FMSgVocStatus = stWaitEndRX )) ) then
begin // raises OnDTMF
inc(p);
if Assigned(FMsgVocDTMF) then
FMsgVocDTMF( Self, Char(p^) );
inc(p);
dec( DataSize );
dec( DataSize );
end
else begin {normal byte received}
if ( Assigned(FMsgVocOnRing) and // verifies RING
(p^ = 'R') and ((p+1)^='I') and ((p+2)^='N') and ((p+3)^='G'))then
FMsgVocOnRing( Self);
FModemDialog := FModemDialog + Char(p^);
FRxChars[FBytesInRxChars] := p^;
if FBytesInRxChars < MAXRXCHARS - 1 then
inc(FBytesInRxChars)
else
FBytesInRxChars := 0;
end;
dec( DataSize );
inc( p );
end;
FRxChars[FBytesInRxChars]:=CHR(0);{null terminated fittizio}
{viene sovrascritto al prossimo giro}
end;
procedure TMsgVoc.Play(filename : String; numreps : Integer);
begin
SetPlayFile(filename);
if numreps > 0 then
FCountReps := numreps
else
FCountReps := 1;
end;
function TMsgVoc.IsDTMFCode(dtmf : Char) : Boolean;
begin
case dtmf of
'0'..'9','*','#','A'..'D','b','c','d','q','s' :
result := True;
else
result := False;
end;
end;
function TMsgVoc.MemPos(stringa , str_in: PChar; maxchars : Integer) : Integer;
// returns the position of str_in in stringa, if not found it returns -1;
var pos, pos_in, len_in : integer;
begin
pos := 0;
pos_in := 0;
len_in := strlen(str_in);
result := -1;
for pos := 0 to maxchars-1 do begin
while ((pos_in < len_in) and (stringa[pos+pos_in] = str_in[pos_in]))do begin
inc(pos_in);
end;
if pos_in = len_in then begin
result := pos;
exit;
end;
end;
end;
procedure Register;
begin
RegisterComponents('Samples', [TMsgVoc]);
end;
end.