msgvoc.pas

Voice 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.