Дипломная работа: Автоматизация обработки заявок в центре коллективного пользования "ГЕОАНАЛИТИК" ИГГ УРО РАН

Внимание! Если размещение файла нарушает Ваши авторские права, то обязательно сообщите нам
112
If (typeOfMess = '0') Then
ShMess := 'Нет связи с проверяемым сервером или исчезла веб-
страница '+#13#10+'"'+url+'"';
End;
// Перекодировка символов
Function codText (txt : String) : String;
Begin
codText:= StringReplace(txt, ' ', '0PROBEL0', [rfReplaceAll, rfIgnoreCase]);
End;
Function check_through_server (url: String; text_string: String): String;
Var
urlget, html: String;
httpclient: TFPHTTPClient;
Begin
text_string := codText (text_string);
urlget:=
web_module_link+'/mind/check_through_server.php?url='+url+'&text_string='+text_s
tring;
httpclient := TFPHttpClient.Create(Nil);
try
try
html := httpclient.Get(urlget);
except
{ Label5.Caption := 'Нет связи с главным сервером';
Label5.Font.Color := clMaroon;
Label7.Caption := 'Нет связи с главным сервером';}
End;
finally
httpclient.Free;
end;
check_through_server := html;
End;
113
procedure Fill_Array(L : TStrings; var Arr : array of String);
var
s : string;
i : integer;
begin
// тут же можно проверить, хватит ли емкости массива,
// чтобы вместить все данные (if L.Count < High(Arr))
Emails_str:= '';
i := 0;
for s in L do
begin
Arr[i] := s;
Emails_str := Emails_str + '|' + s;
Inc(i);
end;
end;
procedure TForm1.beepClick(Sender: TObject);
begin
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
Memo2_Emails.Lines.SaveToFile('emails.txt');
Label8.Caption := 'Сохранено в файл';
end;
procedure TForm1.BitBtn2Click(Sender: TObject);
begin
Memo2_Emails.Lines.LoadFromFile('emails.txt');
Label8.Caption := 'Восстановлено из файла';
end;
procedure TForm1.BitBtn3Click(Sender: TObject);
begin
end;
114
procedure TForm1.BitBtn4Click(Sender: TObject);
begin
OpenURL(Edit1.Text);
end;
procedure TForm1.Button10Click(Sender: TObject);
begin
Fill_Array(Memo2_Emails.Lines, Emails_arr); // создает строку Emails_str из
строк Memo2_Emails
Label8.Caption := 'Применено';
end;
procedure TForm1.Button11Click(Sender: TObject);
begin
OpenURL(web_module_link+'/mail/log.php');
end;
procedure TForm1.Button12Click(Sender: TObject);
begin
Form3.show;
// Form3.msc('s');
Form3.Button2Click(Button2); //запуск музыки
end;
procedure TForm1.Button13Click(Sender: TObject);
var httpclient: TFPHTTPClient;
url, html, result: String;
duration: Integer;
begin
If ( StrToInt(Edit5.Text) > 0) Then
begin
result := 'no';
duration := StrToInt(Edit5.Text) * StrToInt(Edit3.Text); // сколько неудач *
Интервал
end;
If ( StrToInt(Edit8.Text) > 0) Then
115
begin
result := 'ok';
duration := StrToInt(Edit8.Text) * StrToInt(Edit3.Text); // сколько удач *
Интервал
end;
url:=
web_module_link+'/mind/isok.php?isok='+result+'&nomber='+Edit6.Text+'&duration
='+IntToStr(duration);
httpclient := TFPHttpClient.Create(Nil);
try
try
html := httpclient.Get(url);
except
Label5.Caption := 'Нет связи с главным сервером';
Label5.Font.Color := clMaroon;
Label7.Caption := 'Нет связи с главным сервером';
End;
finally
httpclient.Free;
end;
// ShowMessage(html);
end;
procedure TForm1.Button14Click(Sender: TObject);
begin
Form3.show;
Form3.label2.caption := ShMess ('0', Edit1.Text, Edit4.Text); // показ сообщ
"Нет связи с сервером или исчезла web-страница"
Form3.Button2Click(Button2);
end;
procedure TForm1.Button15Click(Sender: TObject);
begin
with TForm1.Create(Application) do
116
begin
// Parent := Self;
// Top := Top + 100; Left := Left + 100;
Caption := '№'+intToStr(no_form)+' '+'Проверка текста на сайте';
Visible := True;
no_form:= no_form+1;
end;
end;
procedure TForm1.Button16Click(Sender: TObject);
begin
(Sender as TButton).Caption := '1';
end;
// Отправка почты
Procedure SendMail (svyaz: String; text: String; url: String; text_string: String;
emails: String; name: String);
var httpclient: TFPHTTPClient;
urlmail, html: String;
begin
text_string := codText (text_string);
emails := codText (emails);
name := codText (name);
urlmail :=
web_module_link+'/mail/index.php?svyaz='+svyaz+'&text='+text+'&text_string='+tex
t_string+'&url='+url+'&emails='+emails+'&name='+name;
httpclient := TFPHttpClient.Create(Nil);
try
try
html := httpclient.Get(urlmail);
except
{ Label5.Caption := 'Нет связи с главным сервером';
Источник: https://baza.diplomsite.ru/previewfile/1871