var
SpVoice: TspVoice;
Speaker:integer;
SOTokens: ISpeechObjectTokens;
procedure EnumVoices(VoiceNo:integer;Leise:String;Combo:TComboBox); procedure Speak(Rate:integer;T:String); function SoundCheck: boolean; Procedure PCSounder(i : TSound); Procedure Morse(Tx:String); function MailServerTest(SMTP:TIdSMTP;Host:String;User:String;Password:String):boolean; function SendMail(SMTP:TIdSMTP;Host:String;User:String;Password:String;
From:String;ToId:String;Subject:String;Body:String):String; function Country(tld: String):integer; procedure Pro(Module:integer;s:String);
implementation
{------------------------------------------------------------------}
{- function getMACAddress -}
{- -}
{------------------------------------------------------------------} procedure Pro(Module:integer;s:String); var Fse: Text; begin
AssignFile (Fse,'mod'+inttostr(Module)+'.txt');
Rewrite(fse);
write(fse,inttostr(module)+s+Chr(13)+Chr(10));
CloseFile(fse); end;
//---------------------------------------------------------------- // // produce speech from clipboard // //---------------------------------------------------------------- procedure Speak(rate:integer;T:String); begin if Speaker > 0 thenbegin
SpVoice.Voice := SOTokens.Item(Speaker-1);
SpVoice.Rate := rate;
SpVoice.Speak(T, SVSFDefault) end end;
//---------------------------------------------------------------- // // test for sound card // //---------------------------------------------------------------- function SoundCheck: boolean; begin if WaveOutGetNumDevs > 0 then
SoundCheck := true else
SoundCheck := false end;
//---------------------------------------------------------------- // // get voices from machine // //---------------------------------------------------------------- procedure EnumVoices(VoiceNo:integer;Leise:String;Combo:TComboBox); var
i, NoVoices: Integer;
SOToken: ISpeechObjectToken;
dwVersion : double; begin ifnot SoundCheck thenbegin
Speaker := 0;
Combo.Items.AddObject(Leise, nil);
Combo.ItemIndex:=0;
exit; end;
dwVersion := GetVersion(); if (dwVersion >= $80000000) then// no Windows XP begin
Speaker := 0;
Combo.Items.AddObject(Leise, nil);
Combo.ItemIndex:=0;
exit; end;
SpVoice := TSpVoice.Create(nil); //enter silent mode
Combo.Items.Clear;
Combo.Items.AddObject(Leise, nil);
Combo.ItemIndex:=0; //Ensure all events fire
SpVoice.EventInterests := SVEAllEvents;
SOTokens := SpVoice.GetVoices('', '');
NoVoices := SOTokens.Count - 1; for I := 0 to NoVoices do begin //For each voice, store the descriptor in the TStrings list
SOToken := SOTokens.Item(I);
Combo.Items.AddObject(SOToken.GetDescription(0), TObject(SOToken)); //Increment the descriptor reference count to ensure it doesn't get destroyed
SOToken._AddRef; end; if NoVoices >= 0 then
Combo.ItemIndex := 0; //Select 1st voice // set options if (NoVoices >=1) and
(VoiceNo <= Combo.Items.Count) thenbegin
Speaker := VoiceNo;
Combo.ItemIndex := Speaker; end; end;
//---------------------------------------------------------------- // // produce pc speaker beeps // with predefined songs // //---------------------------------------------------------------- procedure PCSpeakerBeep(Frequency, Duration: Integer); begin if Win32Platform = VER_PLATFORM_WIN32_NT then
Windows.Beep(Frequency, Duration) else asm
MOV ECX, Frequency
JCXZ @@2
MOV EAX, 1193181
CDQ
IDIV ECX
MOV ECX, EAX IN AL, ($61)
TEST AL, $03
JNZ @@1 OR AL, $03 OUT ($61), AL
MOV AL, $B6 OUT ($43), AL
@@1: MOV AL, CL OUT ($42), AL
MOV AL, CH OUT ($42), AL
PUSH Duration
CALL Windows.Sleep
@@2: IN AL, ($61) AND AL, $FC OUT ($61), AL end; end;
//------------------------------------------------------------------ // // Procedure PCSounder // for to sound from PC beeper loauspeaker // //------------------------------------------------------------------ Procedure Morse(Tx:String); const
dit = 100;
dah = 300;
CH = chr(1);
KA = chr(2); // Spruchanfang
BT = chr(3); // Pause
AR = chr(4); // Spruchende
VE = chr(5); // verstanden
SK = chr(6); // Verkehrsende
SOS = chr(7); // Seenotruf
IRRUNG = chr(8); // Wiederholung ab letztem richtigen Wort
var i:integer; procedure Tone(f : real;d : integer); var
frequency : longint;
dure:variant; begin
frequency := trunc(f);
dure := d;
PCSpeakerBeep(frequency,dure);
sleep(dure); //SetVoiceSound(1,frequency,trunc(d*Tempo)) end; {Tone} procedure Pause(d : integer;Tempo : real); begin
Sleep(d); // SetVoiceSound(1,frequency,trunc(d*Tempo)) end; {Pause} procedure sh; begin Tone(1000,dit); end; procedure lo; begin Tone(1000,dah); end; procedure pa; begin Pause(dit,1); end; procedure letter(x:char); begin case x of 'a': begin sh;lo; end; 'b': begin lo;sh;sh;sh; end; 'c': begin lo;sh;lo;sh; end; 'd': begin lo;sh;sh; end; 'e': begin sh; end; 'f': begin sh;sh;lo;sh; end; 'g': begin lo;lo;sh; end; 'h': begin sh;sh;sh;sh; end; 'i': begin sh;sh; end; 'j': begin sh;lo;lo;lo; end; 'k': begin lo;sh;lo; end; 'l': begin sh;lo;sh;sh; end; 'm': begin lo;lo; end; 'n': begin lo;sh; end; 'o': begin lo;lo;lo; end; 'p': begin sh;lo;lo;sh; end; 'q': begin lo;lo;sh;lo; end; 'r': begin sh;lo;sh; end; 's': begin sh;sh;sh; end; 't': begin lo; end; 'u': begin sh;lo;lo; end; 'v': begin sh;sh;sh;lo; end; 'w': begin sh;lo;lo; end; 'x': begin lo;sh;sh;lo; end; 'y': begin lo;sh;lo;lo; end; 'z': begin lo;lo;sh;sh; end; '0': begin lo;lo;lo;lo;lo; end; '1': begin sh;lo;lo;lo;lo; end; '2': begin sh;sh;lo;lo;lo; end; '3': begin sh;sh;sh;lo;lo; end; '4': begin sh;sh;sh;sh;lo; end; '5': begin sh;sh;sh;sh;sh; end; '6': begin lo;sh;sh;sh;sh; end; '7': begin lo;lo;sh;sh;sh; end; '8': begin lo;lo;lo;sh;sh; end; '9': begin lo;lo;lo;lo;sh; end; 'Á', 'Å': begin sh;lo;lo;sh;lo; end; 'Ä': begin sh;lo;sh;lo; end; 'Ö': begin lo;lo;lo;sh; end; 'Ü': begin sh;sh;lo;lo; end; 'ß': begin lo;lo;lo;sh;sh;lo;lo; end;
CH: begin lo;lo;lo;lo; end; 'Ñ': begin lo;lo;sh;lo;;lo; end; '.': begin sh;lo;sh;lo;sh;lo; end; ',': begin lo;lo;sh;sh;lo;lo; end; ':': begin lo;lo;lo;sh;sh;sh; end; ';': begin lo;sh;lo;sh;lo;sh; end; '?': begin sh;sh;lo;lo;sh;sh; end; '-': begin lo;sh;sh;sh;lo; end; '(': begin lo;sh;lo;lo;sh; end; ')': begin lo;sh;lo;lo;sh;lo; end; '''': begin sh;lo;lo;lo;lo;sh; end; '=': begin sh;lo;lo;lo;sh; end; '+': begin sh;lo;sh;lo;sh; end; '/': begin lo;sh;sh;lo;sh; end; '@': begin sh;lo;lo;sh;lo;sh; end;
KA: begin lo;sh;lo;sh;lo; end;
BT: begin lo;sh;sh;sh;lo; end;
AR: begin sh;lo;sh;lo;sh; end;
VE: begin sh;sh;sh;lo;sh; end;
SK: begin sh;sh;sh;lo;sh;lo; end;
SOS: begin sh;sh;sh;lo;lo;lo;sh;sh;sh; end;
IRRUNG: begin sh;sh;sh;sh;sh;sh;sh;sh; end; ' ': begin pa;pa;pa;pa;pa;pa;pa; end; else begin sh;sh;lo;lo;sh;sh; end; // Irrung end; end; begin
letter(KA); for i:=1 to Length(Tx) do begin letter(tx[i]);pa;pa;pa; end;
letter(AR); end;
//------------------------------------------------------------------ // // Procedure PCSounder // for to sound from PC beeper loauspeaker // //------------------------------------------------------------------ Procedure PCSounder(i : TSound); const
c000 = 32.70;
c00 = 65.41;
c0 = 130.81;
g0 = 196.0;
a0 = 220.0;
h0 = 246.94;
c = 261.63;
cis = 277.18;
d = 293.67;
es = 311.13;
e = 329.63;
f = 349.23;
fis = 369.99;
g = 392.0;
ass = 415.31;
gis = ass;
a = 440.0;
b = 466.16;
h = 493.88;
c1 = 261.63;
c2 = 523.25;
c3 = 1046.51;
c4 = 2093.02;
c5 = 4186.03;
full = 512;
half = 256;
Quart = 128;
eigth = 64; var
Hz : real;
j : integer;
BaseTone : integer;
Offset : integer;
Tempo : real; procedure Tone(f : real;d : integer); var
frequency : longint;
dure:variant; begin
frequency := trunc(f);
dure := d * Tempo;
PCSpeakerBeep(frequency,dure);
sleep(dure); //SetVoiceSound(1,frequency,trunc(d*Tempo)) end; {Tone} procedure Pause(d : integer;Tempo : real); begin
Sleep(d); // SetVoiceSound(1,frequency,trunc(d*Tempo)) end; {Pause}
begin case i of
HappyBirthDay : begin
Tempo := 1;
Tone(g,quart+eigth);
Tone(g,eigth);
Tone(a,half);
Tone(g,half);
Tone(c2,half);
Tone(h,full);
Tone(g,quart+eigth);
Tone(g,eigth);
Tone(a,half);
Tone(g,half);
Tone(2*d,half);
Tone(c2,full);
Tone(g,quart+eigth);
Tone(g,eigth);
Tone(g*2,half);
Tone(e*2,half);
Tone(c2,quart);
Tone(c2,quart);
Tone(c2,half);
Tone(a,half);
Tone(f*2,quart+eigth);
Tone(f*2,eigth);
Tone(e*2,half);
Tone(c2,half);
Tone(d*2,half);
Tone(c2,full); end;
SongofJoy : begin
Tempo := 4.0 / 3.0;
Tone(e,quart);
Tone(e,quart);
Tone(f,quart);
Tone(g,quart);
Tone(g,quart);
Tone(f,quart);
Tone(e,quart);
Tone(d,quart);
Tone(c,quart);
Tone(c,quart);
Tone(d,quart);
Tone(e,quart);
Tone(e,quart+eigth);
Tone(d,eigth);
Tone(d,half+quart);
//send mail try try
SMTP.Connect;
SMTP.Send(MailMessage); except on E:Exception do
Status:='ERROR: ' + E.Message; end; finally if SMTP.Connected then
SMTP.Disconnect; end;
SendMAil:=Status end; (* btnSendMail Click *)
function MailServerTest(SMTP:TIdSMTP;Host:String;User:String;Password:String):boolean; var MAilMessage:TidMessage;Status:boolean; begin //setup SMTP
SMTP.Host := Host;
SMTP.Port := 25;
Status:=true;
//setup mail message
MailMessage:=TIdMessage.Create;
MailMessage.From.Address := 'From';
MailMessage.Recipients.EMailAddresses := 'ToId';
Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.
Bemerkung:
Die farbliche Syntaxdarstellung ist noch experimentell.
