Parts of SAYIT
Contents of this page
- VOICE.PAS, Unit with voice-modem functions
- MANAGER.PAS, Handles answering machine functions like answer incoming call
VOICE.PAS
{************************************************}
{ }
{ UNIT VOICE Voice Funktionen fr SayIt }
{ Copyright (c) 1994-95 by Tom Wellige }
{ Donated as FREEWARE }
{ }
{ E-Mail: wellige@geocities.com }
{ }
{************************************************}
unit Voice;
{$O+,F+}
interface
uses
Crt, App, Objects, Drivers,
ComPort, (* COM-Unit von Thomas Haukap, c't 6/94 *)
Files, (* Datei-Unit von Thomas Haukap, c't 6/94 *)
TWApp, TWComApp, TWIni, TWWindow,
Constant, Global;
type
TVoiceFileHeader = record { Headerstruktur Voice-Datei }
Ident : array[0..5] of char; { 'ZyXEL'#2 oder 'ADPCM'#2 }
Dummy1 : array[0..3] of byte; { unbenutzt }
Compression : word; { Kompressionsart: }
{ ZyXEL: 0=CELP, 1=ADPCM2, 2=ADPCM3 }
{ Rockwell: 0=ADPCM2, 1=ADPCM3, 2=ADPCM4 }
Dummy2 : array[0..3] of byte; { unbenutzt }
end;
PVoiceApp = ^TVoiceApp;
TVoiceApp = object(TComApp)
procedure HandleEvent(var Event: TEvent); virtual;
(* schaltet Modem in Voice-Modus *)
function InitVoice(Port: word): word;
(* schaltet Modem in dem AT-Modus *)
function DoneVoice: word;
(* nimmt Voice in Datei F auf *)
function RecordVoice(F: string): word;
(* spielt Voice aus Datei ab *)
function PlayVoice(F: string): word;
end;
const
cmInitVoice = 5050; { Message: rufe InitVoice auf }
cmDoneVoice = 5051; { Message: rufe DoneVoice auf }
cmPlayVoice = 5052; { Message: rufe PlayVoice auf }
cmRecordVoice = 5053; { Message: rufe RecordVoice auf }
const
recOk = 0; { alles Ok }
recCanceld = 1; { mit ESC abgebrochen }
recError = 2; { Dateifehler }
recSilence = 3; { Stille erkannt }
const
playOk = 0; { alles Ok }
playCanceld= 1; { mit ESC abgebrochen }
playError = 2; { Dateifehler }
const
ptLine = 0; { Port: Telefonleitung }
ptSpeaker = 1; { Port: Lautsprecher }
ptMic = 2; { Port: Mikrofon }
ptBlaster = 3; { Port: SoundBlaster }
const
VoiceFileHeader: TVoiceFileHeader =
( Ident: ''; Dummy1: (0,0,0,0);
Compression: 2; Dummy2: (0,0,0,0));
implementation
function UpString(s: string): string;
var i: integer;
begin
for i:=1 to length(s) do s[i]:= UpCase(s[i]);
UpString:= s;
end;
procedure TVoiceApp.HandleEvent(var Event: TEvent);
var
Return: word;
FileName: string;
begin
if Event.What = evBroadCast then
case Event.Command of
cmInitVoice : begin
ClearEvent(Event);
Return:= InitVoice(Device);
Event.InfoPtr:= @Return;
end;
cmDoneVoice : begin
ClearEvent(Event);
Return:= DoneVoice;
Event.InfoPtr:= @Return;
end;
cmPlayVoice : begin
FileName:= PString(Event.InfoPtr)^;
Return:= PlayVoice(FileName);
ClearEvent(Event);
Event.InfoPtr:= @Return;
end;
cmRecordVoice: begin
FileName:= PString(Event.InfoPtr)^;
Return:= RecordVoice(FileName);
ClearEvent(Event);
Event.InfoPtr:= @Return;
end;
end;
inherited HandleEvent(Event);
end;
function TVoiceApp.InitVoice(Port: word): word;
var
Return: word;
s: string;
begin
SendString(MdmStartVoice+cr); { Voice-Modus einschalten }
if not AwaitStr(crlf) then Return:= recCanceld;
SendString(MdmSetSilence+cr); { Stilleerkennung einschalten }
if not AwaitStr(crlf) then Return:= recCanceld;
SendString(MdmSelComp2+cr); { Kompressionsart einstellen }
if not AwaitStr(crlf) then Return:= recCanceld;
case Port of
ptLine : s:= MdmSelLine; { Port: Telefonleitung }
ptSpeaker: s:= MdmSelSpk; { Port: Lautsprecher }
ptMic : s:= MdmSelMic; { Port: Mikrofon }
ptBlaster: s:= ''; { noch nicht eingebunden }
end;
SendString(s+cr); { Port auswhlen }
if not AwaitStr(crlf) then Return:= recCanceld;
InitVoice:= Return;
end;
function TVoiceApp.DoneVoice: word;
var
Return: word;
S: string;
P: PMessageWindow;
begin
s:= ' bitte warten ...'; { "bitte warten ..." Fenster }
P:= New(PMessageWindow, Init('', PString(@s)));
Insert(P);
SendString(MdmStopVoice+cr); { Voice-Modus ausschalten }
if not AwaitStr('OK'+crlf) then Return:= recCanceld;
Delay(100);
SendString(MdmHangUp+cr); { auflegen }
if not AwaitStr('OK'+crlf) then Return:= recCanceld;
Delete(P);
Dispose(P, Done);
end;
function TVoiceApp.RecordVoice(F: string): word;
var
c, k : char;
StopRequested : boolean; { Benutzer mchte abbrechen }
StopRecord : boolean; { Ende der Aufnahme erreicht }
GotDLE : boolean; { true, wenn das letzte Zeichen DLE war }
Return : word; { Rckgabe der Funktion }
S: string;
P: PMessageWindow;
begin
Return:= recOk;
F:= UpString(F);
s:= 'zeichne ' + F + ' auf ...';
P:= New(PMessageWindow, Init('', PString(@s)));
Insert(P);
SendString(MdmRecVoice+cr);
if not AwaitStr('CONNECT') then Return:= recCanceld;
if FOpen(F, true) <> 0 then Return:= recError;
if Return = recOk then
begin
MdmIdent:= MdmIdent + ' ';
VoiceFileHeader.Ident[0]:= MdmIdent[1];
VoiceFileHeader.Ident[1]:= MdmIdent[2];
VoiceFileHeader.Ident[2]:= MdmIdent[3];
VoiceFileHeader.Ident[3]:= MdmIdent[4];
VoiceFileHeader.Ident[4]:= MdmIdent[5];
VoiceFileHeader.Ident[5]:= #2;
FWrite(@VoiceFileHeader, sizeof(VoiceFileHeader));
StopRequested := false;
StopRecord := false;
GotDLE := false;
while not(StopRecord) do
begin
if DataThere then { Zeichen vorhanden? }
begin
c:= Receive; { Auslesen des Zeichens }
if GotDLE then { War das letzte Zeichen }
begin { ein DLE? Ja. }
if c = dle then { aktuelles Zeichen DLE? }
putc(c) { Ja ==> Datenbyte DLE }
else
if c = etx then { Kommando ETX? }
StopRecord:= true { Ja, Aufnahme beendet }
else { Nein, also wurde ein }
begin { Ereignis erkannt }
if (c='s') or (c='q') then { Stille erkannt? }
begin
if not(StopRequested) then { bereits Ende angefordert }
begin
Return:= recSilence;
Send('A'); Send('T'); { Modem Ende der }
StopRequested := true; { Aufzeichnung signalisieren }
end;
end;
end;
GotDLE := false; { letztes Zeichen kein DLE mehr }
end else
begin { Letzte Zeichen war kein DLE }
if c = dle then { aktuelles Zeichen DLE? }
GotDLE := true { Ja, keine weiteren Aktionen }
else { bis zum nchsten Zeichen }
putc(c); { Kein DLE, normales Datenbyte }
end;
end else
if Keypressed then { Abbruch mit ESCAPE }
begin
k:= readkey;
if k = #27 then
if not(StopRequested) then { Abbruch schon angefordert ? }
begin
Send('A'); Send('T'); { Modem Ende der }
StopRequested := true; { Aufzeichnung signalisieren }
end;
end;
end;
{ auf AT-Modus warten }
if not AwaitStr('VCON'+crlf) then Return:= recCanceld;
FClose;
end;
Delete(P);
Dispose(P, Done);
RecordVoice:= Return;
end;
function TVoiceApp.PlayVoice(F: string): word;
var
c, k: char;
StopRequested: boolean; { Benutzer mchte abbrechen }
Header: TVoiceFileHeader; { Header der Voicedatei }
Return: word;
S: string;
P: PMessageWindow;
begin
Return:= playOk;
F:= UpString(F);
s:= 'spiele ' + F + ' ab ...';
P:= New(PMessageWindow, Init('', PString(@s)));
Insert(P);
{ Datei ffnen }
if FOpen(F, false) <> 0 then Return:= playError;
if Return = playOk then
begin
FRead(@Header, sizeof(Header)); { Datei-Header lesen }
StopRequested:= false;
SendString(MdmPlayVoice+cr); { Daten decodieren }
if not AwaitStr('CONNECT'+crlf) then Return:= playCanceld;
if Return = playOk then
begin
while not (feof) and not(StopRequested) do
begin
c:= getc; { Char aus Datei lesen }
Send(c); { Char an Modem schicken }
if c = dle then Send(c); { DLE doppelt schicken }
if DataThere then { Flukontrolle }
begin
c:= Receive;
if c = xoff then { Modem-Buffer voll }
begin
c:= #00;
while c <> xon do { warten bis Modem wieder }
if DataThere then c:= Receive; { empfangsbereit ist }
end else
if c = dle then { whrend des Absspielens }
begin { werden keine DLE- }
while not(DataThere) do ; { Meldungen ausgewertet }
c:= Receive;
end;
end;
if keypressed then { Abbruch mit ESCAPE }
begin
k:= readkey;
if k = #27 then StopRequested:= true;
end;
end;
if StopRequested then Return:= playCanceld;
Send(dle); Send(etx); { Voiceausgabe abbrechen }
if not AwaitStr('VCON'+crlf) then Return:= playCanceld;
FClose; { Cache sichern, Datei schlieen }
end;
end;
Delete(P);
Dispose(P, Done);
PlayVoice:= Return;
end;
end.
MANAGER.PAS
{************************************************}
{ }
{ UNIT MANAGER }
{ Copyright (c) 1994-95 by T.Wellige & C.Lerch }
{ Donated as FREEWARE }
{ }
{ E-Mail: wellige@geocities.com }
{ }
{************************************************}
unit Manager;
{$O+,F+}
interface
uses
Dos, Objects, Drivers, Views, Dialogs, App,
TWApp, TWComApp, TWViews, TWDialog,
Panels, Constant, Global, Voice;
type
PFileRec = ^TFileRec;
TFileRec = record
Attr: Byte;
Time, Size: LongInt;
Name: PathStr;
end;
PFileNames = ^TFileNames;
TFileNames = object(TCollection)
procedure FreeItem(Item: Pointer); virtual;
end;
PManager = ^TManager;
TManager = object(TView)
ICMList, OGMList, LRCList: PFileNames;
RingCounter: word;
Last_h, Last_m, Last_s: word;
constructor Init;
procedure HandleEvent(var Event: TEvent); virtual;
procedure Update;
procedure UpdateCommands;
procedure UpdateLEDs;
procedure UpdateSegments;
procedure UpdateDevices;
procedure UpdateLists;
procedure PlayFile;
procedure RecordFile;
procedure DeleteFile;
procedure StartSpraPlot;
procedure AnswerCall;
function GetName(l: PFileNames; n: word): string;
function GetNextName(dir: string): string;
function GetFileList(d: string): PFileNames;
function GetDifference(h, m, s: word): word;
end;
implementation
constructor TManager.Init;
var R: TRect;
begin
R.Assign(0,0,1,1);
inherited Init(R);
hide;
Action := ctWaiting;
NumICM := 0;
NumOfICM:= 0;
NumOGM := 0;
NumOfOGM:= 0;
NumLRC := 0;
NumOfLRC:= 0;
UpdateLists;
Update;
end;
procedure TManager.HandleEvent(var Event: TEvent);
var
Return: word;
hh, mm, ss, hs: word;
LastRing: word;
begin
if Event.What = evSerial then
if Event.Command = cmMdRing then
begin
write(#7);
if not assigned(ControlPanel) then
begin
inc(RingCounter);
GetTime(hh, mm, ss, hs);
LastRing:= GetDifference(hh, mm, ss);
if LastRing < 10 then
begin
if RingCounter = NumOfRings then
begin
RingCounter := 0;
AnswerCall;
end;
end else RingCounter:= 0;
end;
end;
inherited HandleEvent(Event);
if Event.What = evCommand then
begin
case Event.Command of
cmICM : Mode:= mdICM;
cmOGM : Mode:= mdOGM;
cmLRC : Mode:= mdLRC;
cmPlayPause: PlayFile;
cmRecord : RecordFile;
cmDeleteMsg: DeleteFile;
cmStop : StartSpraPlot;
cmFoward : case Mode of
mdICM: inc(NumICM);
mdOGM: inc(NumOGM);
mdLRC: inc(NumLRC);
end;
cmRewind : case Mode of
mdICM: dec(NumICM);
mdOGM: dec(NumOGM);
mdLRC: dec(NumLRC);
end;
end;
if NumICM > NumOfICM then NumICM:= NumOfICM; { max. NumOf }
if NumICM = 0 then
if NumOfICM <> 0 then NumICM:= 1 else NumICM:= 0; { min. 0 oder 1 }
if NumOGM > NumOfOGM then NumOGM:= NumOfOGM;
if NumOGM = 0 then
if NumOfOGM <> 0 then NumOGM:= 1 else NumOGM:= 0;
if NumLRC > NumOfLRC then NumLRC:= NumOfLRC;
if NumLRC = 0 then
if NumOfLRC <> 0 then NumLRC:= 1 else NumLRC:= 0;
Update;
end;
if Event.What = evBroadCast then
if Event.Command = cmUpdate then Update;
end;
procedure TManager.AnswerCall;
var FileName: string;
begin
Action:= ctPlay;
Mode := mdAnswer;
Update;
Message(Application, evBroadCast, cmInitVoice, nil);
FileName:= GetName(OGMList, OGM_Number);
Message(Application, evBroadCast, cmPlayVoice, @FileName);
FileName:= System_Dir + 'GONG.RVD';
Message(Application, evBroadCast, cmPlayVoice, @FileName);
FileName:= GetNextName(ICM_Dir);
Message(Application, evBroadCast, cmRecordVoice, @FileName);
Message(Application, evBroadCast, cmDoneVoice, nil);
Action:= ctWaiting;
UpdateLists;
end;
procedure TManager.PlayFile;
var
FileName: string;
Port: word;
begin
Action:= ctPlay;
Update;
Message(Application, evBroadCast, cmInitVoice, nil);
case Mode of
mdICM: FileName:= GetName(ICMList, NumICM);
mdOGM: FileName:= GetName(OGMList, NumOGM);
mdLRC: FileName:= GetName(LRCList, NumLRC);
end;
Message(Application, evBroadCast, cmPlayVoice, @FileName);
Message(Application, evBroadCast, cmDoneVoice, nil);
Action:= ctWaiting;
end;
procedure TManager.RecordFile;
var FileName: string;
begin
Action:= ctRecord;
Update;
Message(Application, evBroadCast, cmInitVoice, nil);
case Mode of
mdOGM : FileName:= GetNextName(OGM_Dir);
mdLRC : FileName:= GetNextName(LRC_Dir);
end;
Message(Application, evBroadCast, cmRecordVoice, @FileName);
Message(Application, evBroadCast, cmDoneVoice, nil);
Action:= ctWaiting;
UpdateLists;
end;
procedure TManager.DeleteFile;
var FileName: string;
begin
case Mode of
mdICM: FileName:= GetName(ICMList, NumICM);
mdOGM: FileName:= GetName(OGMList, NumOGM);
mdLRC: FileName:= GetName(LRCList, NumLRC);
end;
if fdelete(FileName) then
begin
UpdateLists;
case Mode of
mdICM: dec(NumICM);
mdOGM: dec(NumOGM);
mdLRC: dec(NumLRC);
end;
Update;
end else write(#7);
end;
procedure TManager.StartSpraPlot;
var FileName: string;
begin
case Mode of
mdICM: FileName:= GetName(ICMList, NumICM);
mdOGM: FileName:= GetName(OGMList, NumOGM);
mdLRC: FileName:= GetName(LRCList, NumLRC);
end;
Message(Application, evCommand, cmStartSpraPlot, @FileName);
end;
procedure TManager.Update;
begin
UpdateCommands;
UpdateDevices;
UpdateLEDs;
UpdateSegments;
end;
procedure TManager.UpdateCommands;
begin
case Mode of
mdAnswer: DisableCommands([cmRewind, cmPlayPause, cmFoward, cmStop,
cmRecord, cmDeleteMsg, cmArchivMsg]);
mdICM: begin
DisableCommands([cmRecord]);
EnableCommands([cmDeleteMsg, cmArchivMsg]);
if NumOfICM > 0 then
EnableCommands([cmPlayPause, cmStop]) else
DisableCommands([cmPlayPause, cmStop]);
if NumICM > 1 then
EnableCommands([cmRewind]) else
DisableCommands([cmRewind]);
if (NumICM < NumOfICM) and (NumOfICM > 0) then
EnableCommands([cmFoward]) else
DisableCommands([cmFoward]);
end;
mdOGM: begin
DisableCommands([cmArchivMsg]);
EnableCommands([cmDeleteMsg, cmRecord]);
if NumOfOGM > 0 then
EnableCommands([cmPlayPause, cmStop]) else
DisableCommands([cmPlayPause, cmStop]);
if NumOGM > 1 then
EnableCommands([cmRewind]) else
DisableCommands([cmRewind]);
if (NumOGM < NumOfOGM) and (NumOfOGM > 0) then
EnableCommands([cmFoward]) else
DisableCommands([cmFoward]);
if not ((Action = ctPlay) or (Action = ctPause)) then
EnableCommands([cmRecord]) else
DisableCommands([cmRecord]);
end;
mdLRC: begin
DisableCommands([cmArchivMsg]);
EnableCommands([cmDeleteMsg, cmRecord]);
if NumOfLRC > 0 then
EnableCommands([cmPlayPause, cmStop]) else
DisableCommands([cmPlayPause, cmStop]);
if NumLRC > 1 then
EnableCommands([cmRewind]) else
DisableCommands([cmRewind]);
if (NumLRC < NumOfLRC) and (NumOfLRC > 0) then
EnableCommands([cmFoward]) else
DisableCommands([cmFoward]);
if not ((Action = ctPlay) or (Action = ctPause)) then
EnableCommands([cmRecord]) else
DisableCommands([cmRecord]);
end;
end;
end;
procedure TManager.UpdateLEDs;
var w, v: byte;
begin
if not Assigned(ControlPanel) then Action:= ctAnswer else
if Action = ctAnswer then Action:= ctWaiting;
if Assigned(StatusPanel) then
begin
if Action = ctAnswer then w:= clRed else w:= clRed; { PowerLED }
Message(LED_Power, evBroadCast, cmChangeLED, @w);
if not Assigned(ControlPanel) then { AnswerLED }
begin
if NumOfICM > 0 then w:= clRed_Blink else w:= clRed;
end else w:= clOff;
Message(LED_Answer, evBroadCast, cmChangeLED, @w);
if Action in [ctPlay,ctPause,ctRecord,ctRecordPause] then { In_UseLED }
w:= clGreen_Blink else w:= clOff;
Message(LED_In_Use, evBroadCast, cmChangeLED, @w);
end;
if Assigned(ModemPanel) then
begin { PlayLED }
if not ((Action = ctPlay) or (Action = ctPause)) then w:= clOff else
if Action = ctPlay then w:= clGreen else w:= clGreen_Blink;
Message(LED_Play, evBroadCast, cmChangeLED, @w);
if (Action = ctRecord) or (Action = ctRecordPause) then { RecordLED }
begin
if Action = ctRecord then w:= clRed else w:= clRed_Blink;
Message(LED_Rec, evBroadCast, cmChangeLED, @w);
end else
begin
w:= clOff;
Message(LED_Rec, evBroadCast, cmChangeLED, @w);
end;
if Device = dvLine then w:= clYellow else w:= clOff; { LineLED }
Message(LED_Line, evBroadCast, cmChangeLED, @w);
if Device = dvSpeaker then w:= clYellow else w:= clOff; { SpkLED }
Message(LED_Spk, evBroadCast, cmChangeLED, @w);
if Device = dvMic then w:= clYellow else w:= clOff; { MicLED }
Message(LED_Mic, evBroadCast, cmChangeLED, @w);
end;
end;
procedure TManager.UpdateSegments;
var n, h, l: word;
begin
if Assigned(StatusPanel) then
begin
if not Assigned(ControlPanel) then n:= NumOfICM else
case Mode of
mdICM: n:= NumICM;
mdOGM: n:= NumOGM;
mdLRC: n:= NumLRC;
end;
h:= n div 10;
l:= n mod 10;
if n > 99 then
begin
h:= 16;
l:= 16;
end;
Message(SEG_Hi, evBroadCast, cmChange7Segment, @h);
Message(SEG_Lo, evBroadCast, cmChange7Segment, @l);
end;
end;
procedure TManager.UpdateDevices;
begin
case Mode of
mdAnswer: Device:= DevAnswer;
mdICM : Device:= DevICM_Play;
mdOGM : case Action of
ctRecord, ctRecordPause: Device:= DevOGM_Rec;
else Device:= DevOGM_Play; end;
mdLRC : case Action of
ctRecord, ctRecordPause: Device:= DevLRC_Rec;
else Device:= DevLRC_Play; end;
end;
end;
procedure TManager.UpdateLists;
begin
if assigned(ICMList) then dispose(ICMList, Done);
if assigned(OGMList) then dispose(OGMList, Done);
if assigned(LRCList) then dispose(LRCList, Done);
ICMList:= GetFileList(ICM_Dir);
OGMList:= GetFileList(OGM_Dir);
LRCList:= GetFileList(LRC_Dir);
if assigned(ICMList) then NumOfICM:= ICMList^.Count else NumOfICM:= 0;
if assigned(OGMList) then NumOfOGM:= OGMList^.Count else NumOfOGM:= 0;
if assigned(LRCList) then NumOfLRC:= LRCList^.Count else NumOfLRC:= 0;
if (NumICM = 0) and (NumOfICM > 0) then NumICM:= 1;
if (NumOGM = 0) and (NumOfOGM > 0) then NumOGM:= 1;
if (NumLRC = 0) and (NumOfLRC > 0) then NumLRC:= 1;
end;
function TManager.GetName(l: PFileNames; n: word): string;
begin
GetName:= PFileRec(l^.at(n-1))^.Name;
end;
function TManager.GetNextName(dir: string): string;
var
attr, num, yy, mm, dd, dw: word;
filename, n, y, m, d: string;
f: file;
begin
num:= 0;
GetDate(yy, mm, dd, dw);
str(yy, y); str(mm, m); str(dd, d); str(num, n);
y:= copy(y, 3, 2);
if m[0] = #1 then m:= '0' + m;
if d[0] = #1 then d:= '0' + d;
if n[0] = #1 then n:= '0' + n;
filename:= dir + y + m + d +
