Жизнь замечательных грибов
Разработки на Lazarus
Решим задачу кросплатформенно:
|
1 2 3 4 5 6 7 8 9 10 11 12 |
procedure TForm1.GetUserLogin(Sender: TObject); {$IFDEF MSWINDOWS} const envVar = 'USERNAME'; {$ENDIF} {$IFDEF UNIX} envVar = 'USER'; {$ENDIF} begin user_login:=SysUtils.GetEnvironmentVariable(envVar); MessageDlg(user_login, mtInformation,[mbOk],0); end; |
Задача: прочитать Json с URL и распарсить его
Решение:
На неком удалённом ресурсе находится файл вида:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 |
{ "error": false, "result": [ { "dt": "2023-01-16T10:49:14", "url": "https://rfefe.грибовы.рф/?p=41", "title": "Очень важное уведомление", "text": "Олала", "read": true }, { "dt": "2023-01-15T10:49:14", "url": "https://erferf.грибовы.рф/?p=40", "title": "Очень важное уведомление 2", "text": "Олала 2", "read": false } ] } |
Сначала прочитаем файл в строку, а затем распарсим полученный json и переберем его в виде массива или выведем текст ошибки:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 |
procedure TForm1.LoadJson(Sender: TObject); var url, json : String; jsd: TJSONData; error : Boolean; Arr:TJSONData; i : integer; begin url := 'http://ewrdfwerf.xn--90acbu5aj5f.xn--p1ai/get_events.php'; Try json := TFPCustomHTTPClient.SimpleGet(url); Except json:='{"error": true,"result": "Ошибка получения данных"}'; end; jsd:=GetJSON(json); error := jsd.FindPath('error').AsBoolean; if error=true then begin MessageDlg(jsd.FindPath('result').AsString, mtInformation,[mbOk],0); end; if error=false then begin for i:=0 to jsd.FindPath('result').Count-1 do begin MessageDlg(jsd.FindPath('result').Items[i].FindPath('title').AsString, mtInformation,[mbOk],0); end; end; end; |
|
1 2 |
Эх..давно я шашку в руки не брал (лет 10 точно уже с Lazarus/Delphi дела не имел), а тут снова пришлось.
За работу с треем, в Lazarus отвечает компонент TrayIcon, Перетащим её на форму. В процедуре создания формы разместим:
|
1 2 3 |
TrayIcon1.Visible := True; Application.ShowMainForm:= False; |
Далее добавим событие по клику на иконку трея:
|
1 2 3 |
Show; // показываем окно WindowState := wsNormal; // разворачиваем окно |
Без сторонних компонентов обойтись к сожалению не удалось. Модуль который рекомендуют использовать в интернетиках fphttpclient — заставить работать не удалось — падал в access violation… Поэтому пришлось подключать компоненты synaptic:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 |
var httpsend; function GetWebPageContent(const Url: string): String; var fs: TStringList; HTTP: THTTPSend; begin fs := TStringList.Create; HTTP := THTTPSend.Create; try HTTP.HTTPMethod('GET', Url); fs.LoadFromStream(Http.Document); Result := fs.Text; finally fs.Free; http.Free; end; end; |
На этом все. Теперь достаточно после uses добавлять необходимые для использования компоненты. Вот так например выглядит простейший пример отправки письма с вложением.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 |
function SendMail (Host, Subject, pTo, From , TextBody, HTMLBody, login,password,filename : string) : boolean; var Msg : TMimeMess; // сообщение StringList : TStringList; // содержимое письма MIMEPart : TMimePart; // части сообщения (на будущее) begin Msg := TMimeMess.Create; // создаем новое сообщение // IdealCharsets:=[CP1251]; // Msg.Header.CharsetCode:='CP1251'; StringList := TStringList.Create; try // Добавляем заголовки Msg.Header.Subject := Subject;// тема сообщения Msg.Header.From := From; // имя и адрес отправителя Msg.Header.ToList.Add(pTo); // имя и адрес получателя // создаем корневой элемент // MIMEPart := Msg.AddPartMultipart('alternative', nil); Msg.AddPartMultipart('', nil); if length(TextBody)=0 then // если формат HTML begin StringList.Text := HTMLBody; Msg.AddPartHTML(StringList, Msg.MessagePart); end else // если текстовый формат begin StringList.Text := TextBody; Msg.AddPartText(StringList, Msg.MessagePart); end; if filename<>'' then Msg.AddPartBinaryFromFile(filename,Msg.MessagePart); // Кодируем и отправляем Msg.EncodeMessage; // Отправляем. if smtpsend.SendToRaw(From,pTo,Host,Msg.Lines,login,password) then SendMail:=true else SendMail:=false; finally Msg.Free; StringList.Free; end; end; |