カテゴリー別アーカイブ: 未分類

Lazarusコンボボックスの初期値設定

Lazarusコンボボックスの初期値設定

時間設定のコンボボックスを作成してみた
初期値として
時間(0から23)と分(0から55分で5分刻み)
をセットする

時間
00,01,02,03,04,05,06,07,08,09,10,11,12,13,14,15,16,17,18,19,20,21,22,23


00,05,10,15,20,25,30,35,40,45,50,55
とする。(文字列)

まず、2つのコンボボックスを作り

オブジェクトインスペクタ
プロパティ
Items
Stringエディタから
初期値を入れることができた

Lazarus で、リストデータの移動処理を行ってみた

Lazarus で、リストデータの移動処理を行ってみた

リストデータの受け渡しのための
データの移動追加の処理を行ってみた

環境
Ubuntu16
Lazarus 2.0.10

参考ページ
https://www.migaro.co.jp/contents/products/delphi400/tips/introduction/4_20/02/01.html
http://delfusa.main.jp/delfusafloor/archive/www.nifty.ne.jp_forum_fdelphi/faq/00055.htm
https://www.migaro.co.jp/contents/products/delphi400/tips/introduction/4_20/02/01.html
http://dp25299446.lolipop.jp/delphi_tips/tips0045.html

ポイント
リストにはListBoxを使う
・項目追加
 ListBox.Items.Add(文字列)
・項目削除
ListBox.Items.Delete(番号);
 選択している行の場合
ListBox.Items.Delete(ListBox.ItemIndex);
・選択しているデータ
 ListBox1.Items[ListBox.ItemIndex]
・選択しているかの判断
 if (ListBox.ItemIndex > -1) Then 選択されている else 選択されていない
・データの永続的処理(ロード、セーブ)
ListBox.Items.LoadFromFile(ファイル名);
ListBox.Items.SaveToFile(ファイル名);
・その他論理演算
 等しい時 =
 等くない時 <>
 論理and and

プログラム

procedure TForm1.FormCreate(Sender: TObject);
begin
  Button1.Caption:='>';
  Button2.Caption:='<';
  Button4.Caption:='adddata';
  Button5.Caption:='delete';
  Button6.Caption:='save';
  Button3.Visible:=False;

  ListBox1.Items.Add('abc-1');
  ListBox1.Items.Add('abc-2');
  ListBox1.Items.Add('abc-3');
  Button3Click(Sender);
  if FileExists('listdata.txt') then
   ListBox2.Items.LoadFromFile('listdata.txt');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ListBox2.Items.Add(ListBox1.Items[ListBox1.ItemIndex]);
  ListBox1.Items.Delete(ListBox1.ItemIndex);
  Button3Click(Sender);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  ListBox1.Items.Add(ListBox2.Items[ListBox2.ItemIndex]);
  ListBox2.Items.Delete(ListBox2.ItemIndex);
  Button3Click(Sender);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
   if  (ListBox1.ItemIndex > -1) and (ListBox1.Items.Count <> 0)  then
    button1.Enabled := True
   else
    button1.Enabled := False;
   if  (ListBox2.ItemIndex > -1) and (ListBox2.Items.Count <> 0)  then
    begin
      button2.Enabled := True;
      button5.Enabled := True;
    end
   else
    begin
      button2.Enabled := False;
      button5.Enabled := False;
    end;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
 ListBox2.Items.Add(edit2.Text);
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
 ListBox2.Items.Delete(ListBox2.ItemIndex);
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
  ListBox2.Items.SaveToFile('listdata.txt');
end;

procedure TForm1.Edit2Change(Sender: TObject);
begin
  if  edit2.text <> '' then
    button4.Enabled := True
   else
    button4.Enabled := False;
end;

procedure TForm1.ListBox1Click(Sender: TObject);
begin
  edit1.Text:=ListBox1.Items[ListBox1.ItemIndex];
  Button3Click(Sender);
end;

procedure TForm1.ListBox2Click(Sender: TObject);
begin
  Button3Click(Sender);
end;
            

Lazarusを日本語化に

Ubuntu16Desktopの英語環境でセットアップした所
Lazarusが英語環境となっていた

Ubuntu16Desktopの環境を
日本語環境に切り替えてた所

Lazarusも日本語環境になった

メニューなどが、日本語となっている

プログラムへの日本語入力はできないので
メモなどで日本語を打ち
コピペする必要がある

Conoha Ubuntu16Desktop日本語化

Conoha Ubuntu16Desktop日本語化にしてみました

参考
https://www.server-world.info/query?os=Ubuntu_20.04&p=japanese
https://qiita.com/myalpine/items/fb45b222924b2e61ea9f

右上の歯車の
System Settings..

から
LanguageSupport

「install/Remove Language..」
を選択
Japanes
を選択し
「Apply」

再起動をして有効にする

再起動は

ttps://eng-entrance.com/linux-ubuntu-reboot

を、参考に

右上のShutdownを選択した後に
Rebootを選択する

LazarusからShellを起動

LazarusからShellを起動してみました

環境
Ubuntu16
Lazarus 2.0.10

ポイント
TProcessからShellを起動
Shellの完了待ちとする方法と、完了待ちしない方法を選択できます

参考ページ
https://wiki.freepascal.org/Executing_External_Programs
https://stackoverflow.com/questions/26977422/execute-commands-in-the-linux-commandline-lazarus-free-pascal

設定
uses
,Process; //追加

プログラム

procedure TForm1.Button1Click(Sender: TObject);
var
  AProcess: TProcess;
begin
  AProcess := TProcess.Create(nil);
  AProcess.CommandLine:='/bin/bash /home/user/xxx/test02.sh';
  AProcess.Options := AProcess.Options + [poWaitOnExit];
  AProcess.Execute;

  AProcess.Free;
  button1.Caption:='ok';
end;  

以下をなくすと、完了を待たずに次のステップに進みます。

  AProcess.Options := AProcess.Options + [poWaitOnExit];

test02.shの例
動作確認用

#!/bin/bash

cd /home/user/xxx/
ls >> /home/user/xxx/log01.txt

Python起動例

#!/bin/bash

source /home/user/env/bin/activate
cd /home/user/xxx/
python test.py
deactivate

Lazarus のバージョンを上げる

環境
Ubuntu16

Lazarus
1.8.2 から 2.0.1へバージョンアップしてみました

sudo dpkg -i fpc-src_3.2.0-1_amd64.deb
sudo dpkg -i fpc-laz_3.2.0-1_amd64.deb
sudo dpkg -i lazarus-project_2.0.10-0_amd64.deb

の順で上書きを試みる

sudo dpkg -i fpc-laz_3.2.0-1_amd64.deb

失敗。fpc の削除 を処理できません (–auto-deconfigure を使いましょう):
lazarus-project は fpc (>= 3.0.4) | fp-utils (>= 3.0.4) に依存 (depends) します
fpc は削除されようとしています。
fp-utils はインストールされていません。

とでたので

sudo dpkg -i --auto-deconfigure fpc-laz_3.2.0-1_amd64.deb

startlazarus
で起動する

UPGRADEのメッセージが表示され指示に従うと
2.0.1へバージョンアップできた。

Ubuntu16 でCronを使ってみる

Ubuntu16 でCronを使ってみる

定期的にプログラムを実行する仕組みを
Cronで行ってみる

参考

Ubuntuでのcronの使い方

まず、確認用の実行プログラムを作る

ファイル名
test.sh

内容

#!/bin/bash

cd /home/userA/test/
ls >> log01.txt

権限を設定
$ chmod 755 test.sh

動作を確認
/bin/bash test.sh

Cronのファイルを複写する
cron_01というファイル名でコピーしています。

$ sudo cp /etc/crontab /etc/cron.d/cron_01

ファイルを編集する

$ sudo vim /etc/cron.d/cron_01
/

スケジュールを追加する(1分ごとに起動)
*/1 * * * *   ubuntu /bin/bash /home/userA/test/test.sh

cronの再起動を行います。(既に起動済の場合は不要)


sudo service cron restart

ファイル
log01.txt
が、追加されているか確認する

削除する場合は
/etc/cron.d/cron_01
を、編集(コメントアウト、削除)

Pythonプログラムを起動する場合

起動するスクリプトを変更
test.sh

#!/bin/bash

source /home/user/env/bin/activate
cd /home/user/test
python test.py
deactivate

test.pyの例
(フォルダーに時間指定のファイル名を出力する)

import time
import datetime
def main():
    html='logdata'
    now = datetime.datetime.now()
    fname = now.strftime('%Y%m%d%H%M%S' + '_01.txt')  # => '2019-08-02 02:20:43'
    with open("log/" + fname, "w") as f:
        f.write(html)
main()

動作確認を行っておくコマンドラインから

/bin/bash test.sh

動作確認ができたら
/etc/cron.d/cron_01
を、編集し、起動するようにする

LazarusでLineBotを作る

LazarusでLineBotを作る

API通信で、LineBotを作ってみます。

環境
Ubuntu16
Lazarus 2.0.10

参考ページ

DelphiでJSON文字列を作成する


http://lazplanet.blogspot.com/2014/09/a-simple-json-parsing-example.html

必要なデータ
LINE_CHANNEL_ACCESS_TOKEN
LINE_SEND_ID // 1対1の送信で、友達になっている送信先のID

事前準備
パッケージ 「indy」を読み込む

ポイント
・JsonのAPI送信のため、Jsonデータを作成し、Strへ変換が必要
・送信データをTStringStreamで作成する必要がある
・HTTPSであるが、LineAPIの場合、idSSLIOHandlerSocketOpenSSL1なしで送れた
・IdHTTPの場合、usesの設定だけではなく、画面に設置しないとエラーになった

宣言部

uses

,IdHTTP
,fpjson,jsonparser  

本体

procedure TForm1.FormCreate(Sender: TObject);
begin
  button1.Caption:='Send';
  edit1.Text:='おはよう!!'; //送信メッセージ
  memo1.Text:=''; //Jsonモニタ用
end;

procedure TForm1.Button1Click(Sender: TObject);
var
ss:TStringStream;
st,st1,LINE_CHANNEL_ACCESS_TOKEN,LINE_SEND_ID:string;

strm:TStringStream;
Data1,Data2 : TJSONObject;
JSONArray: TJSONArray;
begin

  LINE_CHANNEL_ACCESS_TOKEN:="YOUR_CHANNEL_ACCESS_TOKEN";
  LINE_SEND_ID:="SEND_ID";
  IdHTTP1:=TIdHTTP.Create(self);
  strm:=TStringStream.Create('',TEncoding.UTF8);

  IdHTTP1.Request.ContentType:='application/json';
  IdHTTP1.Request.Accept     :='application/json';

  IdHTTP1.Request.CustomHeaders.Add('Authorization:Bearer '+LINE_CHANNEL_ACCESS_TOKEN);

// https://www.gesource.jp/weblog/?p=6067
// http://lazplanet.blogspot.com/2014/09/a-simple-json-parsing-example.html
  Data1 := TJSONObject.Create;
  Data1.Add('type', 'text');
  Data1.Add('text', edit1.Text);

  JSONArray := TJSONArray.Create;
  JSONArray.Add(Data1);
  Data2 := TJSONObject.Create;
  Data2.Add('to', LINE_SEND_ID);

  Data2.Add('messages', JSONArray);
  st1:= Data2.AsJSON;
  Memo1.Lines.Text := st1;

  ss := TStringStream.Create(st1);
  ss.Position := 0;
  st:=IdHTTP1.Post('https://api.line.me/v2/bot/message/push',ss);
  showmessage('send!!');

end;      

LazarusでMysqlに接続する

LazarusでMysqlに接続する

1,接続
2,読み込み(Select)
3,挿入(Insert)
4,アップデート(Update)
5,削除(Delete)

ポイント
 TMySQL55Connection
 TSQLQuery
 TSQLTransaction
を、使用する。

プログラム

設定

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  Grids
  , mysql55conn  // 追加
  , sqldb // 追加
  , db // 追加
  , ComCtrls // 追加

  ;

本体

procedure TForm1.FormCreate(Sender: TObject);
begin
     MySQL55Connection1:= TMySQL55Connection.Create(nil);
     MySQL55Connection1.HostName := 'xxx.xxx.xxx.xxx';
     MySQL55Connection1.CharSet:='utf8mb4';
     MySQL55Connection1.UserName := 'xxxx';
     MySQL55Connection1.Password := 'xxx';
     MySQL55Connection1.DatabaseName:='xxxxx';
     SQLQuery1:= TSQLQuery.Create(nil);
     SQLTransaction1:= TSQLTransaction.Create(nil);
     SQLTransaction1.SQLConnection:=MySQL55Connection1;


     button1.Caption:='search';
     button2.Caption:='select';
     button3.Caption:='insert';
     button4.Caption:='update';
     button5.Caption:='detale';
     button6.Caption:='maketable';


     StringGrid1.RowCount:=1;
     StringGrid1.ColCount:=3;

     StringGrid1.Cells[1,0]:='商品名';
     StringGrid1.Cells[2,0]:='商品コード';


end;
procedure TForm1.Button1Click(Sender: TObject);
var
  StrText:string;
begin
if not MySQL55Connection1.Connected then MySQL55Connection1.Open;
if MySQL55Connection1.Connected then begin
SQLQuery1.DataBase := MySQL55Connection1;
SQLQuery1.SQL.Text := 'select p_name from m_product where p_name="'+edit1.text+'" and p_code = "'+edit2.text+'" ';
         SQLQuery1.Open;
if SQLQuery1.EOF then begin
                   StrText :='商品と商品コードが一致しません';
                   MessageDlg(StrText, mtInformation, [mbYes], 0);
         end
    else  begin
      StrText :='商品と商品コードが一致しました';
      MessageDlg(StrText, mtInformation, [mbYes], 0);
             end;
         SQLQuery1.Close;
end;
MySQL55Connection1.Close();
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  i:integer;
  s:string;
begin
if not MySQL55Connection1.Connected then MySQL55Connection1.Open;
if MySQL55Connection1.Connected then begin
SQLQuery1.DataBase := MySQL55Connection1;
SQLQuery1.SQL.Text := 'select p_name,p_code from m_product ';
         SQLQuery1.Open;
               SQLQuery1.Open;
       i:=1;
       while not SQLQuery1.EOF do
        begin
        if i+1>StringGrid1.RowCount then StringGrid1.RowCount:=StringGrid1.RowCount+1;
//        s:= SQLQuery1.Fields[0].AsString;
//        StringGrid1.Cells[i+1,0]:=SQLQuery1.Fields[0].AsString;
        StringGrid1.Cells[1,i]:=SQLQuery1.FieldByName('p_name').AsString;
        StringGrid1.Cells[2,i]:=SQLQuery1.FieldByName('p_code').AsString;
        i:=i+1;
        SQLQuery1.Next;
        end;
        StringGrid1.RowCount:=i;

      SQLQuery1.Close;
      MySQL55Connection1.Close;
end;


end;

procedure TForm1.Button3Click(Sender: TObject);
var
  i:integer;
  s,sql:string;
begin
if not MySQL55Connection1.Connected then MySQL55Connection1.Open;
if MySQL55Connection1.Connected then begin
   SQLQuery1.DataBase := MySQL55Connection1;

   if not SQLTransaction1.Active then SQLTransaction1.StartTransaction;
   sql:='INSERT into m_product (p_name,p_code,update_date,create_date) VALUES';
   sql:=sql+'("'+edit3.Text+'","'+edit4.Text+'",now(),now())';

   MySQL55Connection1.ExecuteDirect(sql);
   SQLTransaction1.Commit;
    end;
    SQLQuery1.Close;
    Button2Click(Sender);
    MySQL55Connection1.Close;
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  i:integer;
  s,sql:string;
begin
if not MySQL55Connection1.Connected then MySQL55Connection1.Open;
if MySQL55Connection1.Connected then begin
   SQLQuery1.DataBase := MySQL55Connection1;
   if not SQLTransaction1.Active then SQLTransaction1.StartTransaction;
   sql:='update  m_product set p_code="'+edit6.Text+'" where p_name = "'+edit5.Text+'"';
   MySQL55Connection1.ExecuteDirect(sql);
   SQLTransaction1.Commit;
    end;
    SQLQuery1.Close;
    Button2Click(Sender);
    MySQL55Connection1.Close;
end;


procedure TForm1.Button5Click(Sender: TObject);
var
  i:integer;
  s,sql:string;
begin
if not MySQL55Connection1.Connected then MySQL55Connection1.Open;
if MySQL55Connection1.Connected then begin
   SQLQuery1.DataBase := MySQL55Connection1;
   if not SQLTransaction1.Active then SQLTransaction1.StartTransaction;
   sql:='delete from  m_product where p_name = "'+edit7.Text+'"';
   MySQL55Connection1.ExecuteDirect(sql);
   SQLTransaction1.Commit;
    end;
    SQLQuery1.Close;
    edit8.Text:=sql;
    Button2Click(Sender);
    MySQL55Connection1.Close;

end;

procedure TForm1.Button6Click(Sender: TObject);
var
  i:integer;
  s,sql:string;
begin
if not MySQL55Connection1.Connected then MySQL55Connection1.Open;
if MySQL55Connection1.Connected then begin
   SQLQuery1.DataBase := MySQL55Connection1;
   if not SQLTransaction1.Active then SQLTransaction1.StartTransaction;
   sql:=' CREATE TABLE IF NOT EXISTS m_product ( ';
   sql:=sql+'product_id INT(11) NOT NULL AUTO_INCREMENT,';
   sql:=sql+'p_name VARCHAR(20) NOT NULL,';
   sql:=sql+'p_code VARCHAR(50) NOT NULL,';
   sql:=sql+'create_date TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP,';
   sql:=sql+'update_date TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP ON UPDATE CURRENT_TIMESTAMP,';
   sql:=sql+'PRIMARY KEY ("product_id"))COLLATE="utf8mb4_general_ci" ENGINE=InnoDB ';
   MySQL55Connection1.ExecuteDirect(sql);
   SQLTransaction1.Commit;
    end;
    SQLQuery1.Close;
    edit8.Text:=sql;
    MySQL55Connection1.Close;

end;       

サンプルのDB

CREATE TABLE m_product (
	product_id INT(11) NOT NULL AUTO_INCREMENT,
	p_name VARCHAR(20) NOT NULL,
	p_code VARCHAR(50) NOT NULL,
	create_date TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP,
	update_date TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP ON UPDATE CURRENT_TIMESTAMP,
	PRIMARY KEY ('product_id')
)
COLLATE='utf8mb4_general_ci'
ENGINE=InnoDB
;

SQLインジェクションは、未対応、修正が必要

参考
//http://www.366service.com/jp/qa/679747ee836bb2082ae2df224d6839ed

LazarusでJsonを扱ってみた

LazarusでJsonを扱ってみた

参考ページ
https://wiki.freepascal.org/fcl-json

ポイント
・jData : TJSONData;
jData := GetJSON(Json文字列);
 で取り込み、パースする
 例:jData.findpath(‘data’)
 データの取り込み時には、型変換(キャスト)する
 例:jData.findpath(‘data’).Items[i].FindPath(‘name’).AsString;
 配列は、Items[n]で、取り込む

プログラム
宣言部

uses
  ,fpjson,jsonparser; //追加

本体

procedure TForm1.FormCreate(Sender: TObject);
begin
  button1.Caption:='分析(エンコード)';
  button1.Width:=150;
  Memo1.Text:='{"data": [{"name":"abc"}, {"name":"def"},{"name":"hijk"}]}';
  StringGrid1.Cells[1,0]:='No';
  StringGrid1.Cells[2,0]:='name';
  StringGrid1.ColCount:=3;
  StringGrid1.ColWidths[0]:=40;
  StringGrid1.ColWidths[1]:=40;
  StringGrid1.RowCount:=2;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
    jData : TJSONData;
   i:integer;
begin
   // https://wiki.freepascal.org/fcl-json
   jData := GetJSON(Memo1.Text);
   StringGrid1.RowCount:=2;
   for i := 0 to jData.findpath('data').Count - 1 do
   begin
    if i+2>StringGrid1.RowCount then StringGrid1.RowCount:=StringGrid1.RowCount+1;
    StringGrid1.Cells[1,i+1]:=IntToStr(i+1);
    StringGrid1.Cells[2,i+1]:=jData.findpath('data').Items[i].FindPath('name').AsString;
   end;
end;