127
AssignFile(f1, 'name.txt'); //связали файловую переменную с файлом
Reset(f1);
Readln(f1, yourName); //читаем в s очередную строку
CloseFile(f1); //закрываем файл
LabeledEdit1.Text := yourName;
LabeledEdit1.Font.Color := clRed;
InputQuery('Ваше имя?', 'Укажите на чьем компьютере программа:',
yourName);
LabeledEdit1.Text := yourName;
LabeledEdit1.Font.Color := clDefault;
//
Rewrite(f1);
Write(f1, yourName);
CloseFile(f1); //закрываем файл
end;
procedure TForm1.Edit6Change(Sender: TObject);
begin
If(Edit6.Text = '') Then
begin
Label6.Font.Color:= clRed;
end
Else
begin
128
Label6.Font.Color:=clDefault;
end;
end;
{ удалить имя }
procedure TForm1.FormDestroy(Sender: TObject);
var
url, html, who_now: String;
httpclient: TFPHTTPClient;
begin
who_now := LabeledEdit1.Text;
who_now := codText (who_now);
If (Edit6.Text <> '') Then // Введен ли номер экземпляра?
begin
url :=
web_module_link+'/mind/del_name_after_close.php?nomber='+Edit6.Text+'&name='
+who_now;
httpclient := TFPHttpClient.Create(Nil);
try
try
html := httpclient.Get(url);
except
Label5.Caption := 'Нет связи с главным сервером';
Label5.Font.Color := clMaroon;
Label7.Caption := 'Нет связи с главным сервером';
End;
finally
httpclient.Free;
end;
end;
129
end;
procedure TForm1.get_usersClick(Sender: TObject);
Var
url, html, html1, s, who_now: String;
k1: Integer;
sl: TStringList;
httpclient: TFPHTTPClient;
begin
who_now := LabeledEdit1.Text;
who_now := codText (who_now);
If (Edit6.Text <> '') Then // Введен ли номер экземпляра?
begin
url :=
web_module_link+'/mind/time.php?nomber='+Edit6.Text+'&name='+who_now+'&int
erval='+Edit3.Text;
httpclient := TFPHttpClient.Create(Nil);
try
try
html := httpclient.Get(url);
except
Label5.Caption := 'Нет связи с главным сервером';
Label5.Font.Color := clMaroon;
Label7.Caption := 'Нет связи с главным сервером';
End;
finally
httpclient.Free;
end;
130
html1 := html;
//Delete (строка, нач поз, колво) - процедура
Delete (html, 1, 3); // удаление лишних 3 символов в начале полученой
строки
Memo2_whoNow.Lines.Clear;
Memo2_whoNow.Lines.Add(html); // добавление строки в Memo
{
sl := TStringList.Create;
try
sl.Text := html;
sl.Delimiter := '|';
ShowMessage('sl.Items = '+sl.Items);
finally
sl.Free;
end;
}
{
k1:=Pos('|', html);
{ k1:=Pos(<подстрока>,<строка>);
Найдено - k1 = <номер вхождения>
не найдено - k1 = 0 }
// s = Copy ('Строка',нач поз,колво) - копирование строк
s := Copy (html, 1, k1-1);
131
Delete (html, 1, k1); // удаление номера и | после него
ShowMessage ('длина строки: '+IntToStr(Length(html))+#13#10+'k1 :
'+IntToStr(k1));
k1:=Pos('|', html); // поз | полсле url
s := Copy (html, 1, k1-1);
Edit1.Text := s; // Получение url полем
Delete (html, 1, k1); // удаление url и | после него
k1:=Pos('|', html); // поз | полсле text_string
s := Copy (html, 1, k1-1);
Edit4.Text := s; // Получение text_string полем
Delete (html, 1, k1); // удаление text_string и | после него
Edit3.Text := html; // Получение интервал полем
If ( k1 <>0 ) Then
Begin
Label7.Caption := '"|" Получено успешно';
end; }
end
Else
end;
procedure TForm1.CBthrough_serverChange(Sender: TObject);
begin
if (CBthrough_server.Checked) then
132
end;
procedure TForm1.CB_whoNowChange(Sender: TObject);
begin
if (CB_whoNow.Checked = true) then Panel2.Visible:= true
else Panel2.Visible:= false;
end;
procedure TForm1.Label5Click(Sender: TObject);
begin
end;
procedure TForm1.LabeledEdit1Change(Sender: TObject);
begin
end;
procedure TForm1.Memo2_EmailsChange(Sender: TObject);
begin
Memo2_Emails_Canged := 1;
Label8.Caption := 'Поле изменено';
end;
procedure TForm1.Panel3Click(Sender: TObject);
begin
end;
procedure TForm1.StopTimerClick(Sender: TObject);
begin
Timer1.Interval := 0;
133
Timer2.Interval := 0;
StopTimer.Caption := 'Остановлен';
end;
procedure TForm1.CB_MailsChange(Sender: TObject);
begin
if (CB_Mails.Checked = true) then Panel1.Visible:= true
else Panel1.Visible:= false;
end;
{ FormCreate }
procedure TForm1.FormCreate(Sender: TObject);
Var
NomEkz, number, yourName: String;
f1: TextFile;
begin
cicle := 0;
counter := 0;
counter2 := 0;
noConnection := 0;
Memo2_Emails.Lines.LoadFromFile('emails.txt');
Label8.Caption := 'Восстановлено из файла';
Fill_Array(Memo2_Emails.Lines, Emails_arr); // создает строку Emails_str из
строк Memo2_Emails
Panel3.Top := 0;
// Считывание линка до веб модуля
AssignFile(f1, 'web_module_link.txt'); //связали файловую переменную с
файлом
Reset(f1);
Readln(f1, web_module_link); //читаем в s очередную строку
CloseFile(f1); //закрываем файл
134
{ Считывание номера из файла}
AssignFile(f1, 'number.txt'); //связали файловую переменную с файлом
Reset(f1);
Readln(f1, number); //читаем в s очередную строку
CloseFile(f1); //закрываем файл
if (number<>'')then // Если файл не пустой
begin
Panel3.Visible:= false; // скрываем панель
Edit6.Text:=number; // номер из файла - в поле
{ Считывание имени из файла}
AssignFile(f1, 'name.txt'); //связали файловую переменную с файлом
Reset(f1);
Readln(f1, yourName); //читаем в s очередную строку
CloseFile(f1); //закрываем файл
LabeledEdit1.Text := yourName; // имя из файла - в поле
Button6Click (Edit6); // получить настройки с сервера
Button2Click (Edit6); // запустить проверку
end;
end;
{главный таймер}
procedure TForm1.Timer1Timer(Sender: TObject);
var httpclient: TFPHTTPClient;
url, url_mail, html : String;
135
k1 : Integer;
begin
// ShowMessage ('Таймер кончился');
Timer1.Interval := StrToInt(Edit3.Text)*1000;
cicle := Timer1.Interval;
If (Edit6.Text <> '') Then // Если поле "№ экземпляра" - не пустое
Button6Click(Edit1); // Получить данные с сервера
if (Not(CBthrough_server.Checked)) then // Проверка через программу
Begin
httpclient := TFPHttpClient.Create(Nil);
try
try
html := httpclient.Get(Edit1.Text);
except
Label5.Caption := 'Нет связи с сервером или исчезла web-
страница...';
Label5.Font.Color := clMaroon;
noConnection := 1;
counter := counter+1;
counter2 := 0;
if (counter <= 2) Then
begin
SendMail ('0', '0', Edit1.Text, Edit4.Text, Emails_str,
LabeledEdit1.Text ); // связь, текст, url, текст_string
Form3.show;
136
Form3.label2.caption := ShMess ('0', Edit1.Text, Edit4.Text); // показ сообщ
"Нет связи с сервером или исчезла web-страница"
Form3.Button2Click(Button2); //запуск музыки
end;
End;
finally
httpclient.Free;
end;
memo1.Text := html;
k1:=Pos(Edit4.Text, html);
{ k1:=Pos(<подстрока>,<строка>);
Найдено - k1 = <номер вхождения>
не найдено - k1 = 0 }
If (k1 <> 0) then
Begin
Label5.Font.Color := clGreen;
Label5.Caption := 'Найдено!';
counter2 := counter2+1 ;
if ((counter <> 0)And(noInternet <> 1)) then
SendMail ('1', '1', Edit1.Text, Edit4.Text, Emails_str, LabeledEdit1.Text
); // связь, текст, url, текст_string, Emails, Имя
If ((counter <> 0)And(noInternet = 1)) then
SendMail ('2', '1', Edit1.Text, Edit4.Text, Emails_str, LabeledEdit1.Text
); // связь, текст, url, текст_string, Emails, Имя
noInternet := 0;