喜歡 Lazarus 短小精幹跟熟悉的介面, 以及各種平台通吃的特性
小弟工作上週邊函式庫功能都慢慢轉移用 Lazarus 開發作外掛 (如 LinePay 支付通訊模組, 電子發票取號跟列印模組 ....)
在 WIN 7/8/10 上的 RAD TOOL 既癡肥又龐大....., 有了 Lazarus , 那種信手捻來, 隨便就能開發 NATIVE CODE 小程式小工具的手感又回來了

● Lazarus 當漏
https://www.lazarus-ide.org/


● Lazarus 開發商業軟體的問題
http://wiki.lazarus.freepascal.org/Lazarus_Faq/zh_TW#.E6.88.91.E5.8F.AF.E4.BB.A5.E7.94.A8_Lazarus_.E4.BE.86.E8.A3.BD.E4.BD.9C.E5.95.86.E6.A5.AD.E7.A8.8B.E5.BC.8F.E5.97.8E.3F


● indy 元件當漏
http://indy.fulgan.com/ZIP/

解壓後目錄 ..\Lib\indylaz.lpk 就是 Lazarus 的元件安裝包


● SSL 當漏 (TLS V1.2 加密協定) - 搭配 indy 元件
"Could not load SSL library.”之問題要到 http://indy.fulgan.com/SSL/
下載 openssl-1.0.2o-i386-win32.zip 解壓後,
將 libeay32.dll & ssleay32.dll兩個檔案放到執行檔同目錄

編輯記錄

● Lazarus 呼叫財政部電子發票平台提供的 QRDLL.DLL 產生電子發票 QR_CODE 所需的 77 碼 AES 值


//宣告端
procedure QRCodeINV(a_InvoiceNumber: String;
a_InvoiceDate: String;
a_InvoiceTime: String;
a_RandomNumber: String;
af_SalesAmount: Double;
af_TaxAmount: Double;
af_TotalAmount: Double;
a_BuyerIdentifier: String;
a_RepresentIdentifier: String;
a_SellerIdentifier: String;
a_BusinessIdenti: String;
a_AESKey: String;
a_output: PChar;
var ai_errorCode : Integer); STDCALL; external 'QRDLL.DLL';


var
Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
var
out1:String;
errorCode :integer;
begin
SetLength (out1, 78);
QRCodeINV('AA12345678',
'1001231',
'150000',
'1234',
1000000,
100,
1000100,
'12345678',
'87654321',
'12344321',
'43211234',
'05D4A324ABAF4A570E64E572221E438B',
pChar(out1),
errorCode
);
showmessage('errorCode=' inttostr(errorCode));
showmessage('resultTxt=' out1);
end;


//---------------------------------------------------------------------------
//同場加映 : BCB 5.0 呼叫財政部電子發票平台提供的 QRDLL.DLL 產生電子發票 QR_CODE 所需的 77 碼 AES 值
//---------------------------------------------------------------------------

#include
#pragma hdrstop

#include "Unit1.h"
#include
#include
#include
#include

//---------------------------------------------------------------------------
#pragma package(smart_init)
#pragma resource "*.dfm"
TForm1 *Form1;
typedef void (__stdcall *ADDMETHODEX)(char* InvoiceNumber, char* InvoiceDate, char* InvoiceTime, char* RandomNumber, double SalesAmount, double TaxAmount,double TotalAmount, char* BuyerIdentifier, char* RepresentIdentifier, char* SellerIdentifier, char* BusinessIdentifier, char* AESKey, char *output, int *errorCode);

//---------------------------------------------------------------------------
__fastcall TForm1::TForm1(TComponent* Owner)
: TForm(Owner)
{
}
//---------------------------------------------------------------------------

void __fastcall TForm1::Button1Click(TObject *Sender)
{
char out[78];
int *errorCode;
errorCode=(int *)malloc(sizeof(int));
String tmp;

HINSTANCE dll=NULL;
ADDMETHODEX QRCodeINV=NULL;
dll=LoadLibrary("QRDLL.dll"); //動態連結
if(dll!=NULL)
{
QRCodeINV=(ADDMETHODEX)GetProcAddress(dll, "QRCodeINV");
if(QRCodeINV!=NULL)
{
QRCodeINV("AA12345678",
"1001231",
"150000",
"1234",
1000000,
100,
1000100,
"12345678",
"87654321",
"12344321",
"43211234",
"05D4A324ABAF4A570E64E572221E438B",
out,
errorCode);


ShowMessage(IntToStr(*errorCode));
ShowMessage(out);
}
FreeLibrary(dll);
}
}
//---------------------------------------------------------------------------

編輯記錄

謝謝您無私的分享！

好難得有 Lazarus 的文章！感謝樓主分享！

------
歡迎參訪 "腦殘賤貓的備忘錄" http://maolaoda.blogspot.com/

把貓兄的 Lazarus 文章一起加入
http://maolaoda.blogspot.tw/search/label/Lazarus
===================引 用 sryang 文 章===================
好難得有 Lazarus 的文章！感謝樓主分享！

小弟的部落格
http://blog.xuite.net/james.chou408/twblog

不過部落格是很久以前的版本了(五-六年前)
現在的 Lazarus 穩定多了(以現在有在用的 Windows 版 Lazarus 而言)
1.IDE 中- 中文輸入正常
2.UTF-8 CODE
3.強大的 INDY 通訊元件 (一鍵安裝, 以前安裝要改好幾個地方設定才安裝的起來)

十年前的 Lazarus 還很難用, BUG 很多, 但人家十年前就可以用 Lazarus 寫成這樣的程式了

-----------------------------------------------------------------------------------------------
台灣股票軟件 For Lazarus，為Lazarus程序開發人員打打氣!!
億股亨ASUS EeePC Linux
http://www.youtube.com/watch?v=18mUwFOVqrk
全球大亨 WinCE
http://www.youtube.com/watch?gl=TW&hl=zh-TW&v=uZmoJZg5Ppo

原作者 brianwung 提到 :
使用Lazarus 開發近二年，第一個是Linux for ASUS EeePC的股票軟件，是由原本Delphi移值過來的。
第二個是使用Lazarus 新開發的軟件目前WinCE、Win32、Linux沒問題，還在開發階段就是了。
也曾Post到智器Q5、眾一的MID上( Arm Linux )，只差Lnet Socket無法連接，也請教了作者。
目前希望使用Lazarus SDL 開發Android & Iphone，努力中....
使用Lazarus開發其實比其它的更辛苦，Bug很多、3RD元件太少....
但它是真正能跨平台的，不久的將來一定會發揚光大，
希望這篇文章能拋磚引玉讓更多的人加入Lazaurs的開發，也為目前使用Lazarus的人加油。

編輯記錄

現在的版本在 Linux 中輸入中文還是不正常
依然得用插入 TODO 的方式來輸入

===================引 用 lazarus 文 章===================
小弟的部落格
http://blog.xuite.net/james.chou408/twblog

不過部落格是很久以前的版本了(五-六年前)
現在的 Lazarus 穩定多了(以現在有在用的 Windows 版 Lazarus 而言)
1.IDE 中- 中文輸入正常
2.UTF-8 CODE
3.強大的 INDY 通訊元件 (一鍵安裝, 以前安裝要改好幾個地方設定才安裝的起來)

------
歡迎參訪 "腦殘賤貓的備忘錄" http://maolaoda.blogspot.com/

● Lazarus + Indy 處理 "支X寶" 的付款通訊片段

1.使用到 IdHTTP1 及 IdSSLIOHandlerSocketOpenSSL1 兩個 indy 元件
2.要用到 TLS V1.2 加密等級的 HTTPS 通訊
到 http://indy.fulgan.com/SSL/
下載 openssl-1.0.2o-i386-win32.zip 解壓後,
將 libeay32.dll & ssleay32.dll 兩個檔案放到執行檔同目錄

//---------------------------------------------------------------------------
//LinePay-付款功能(POST)
function LP_Payment(ecr_no: pchar; ListIn_Data: pchar; ListOut_Data: pchar): integer; stdcall;  (Content)
var
  rv: Integer; //result 值
  IdHTTP1: TIdHTTP;
  IdSSLIOHandlerSocketOpenSSL1: TIdSSLIOHandlerSocketOpenSSL;
  RequestBody: TStringStream;
  json: string;
  json_out: string;
  JSONstring: TJSONData; //uses fpjson
  JSONReceived: TJSONObject;
  TmpList: TStringList;
  url: string;
  exception_message: string;
begin
  InitVar(ecr_no); //讀入公用變數值. 如讀入 Payment_url(付款的 URL 網址等等)

  SaveLog(ecr_no, '●Call LP_Payment() Start ...(LinePay-付款功能)');

  rv:=0; //result 值
  IdHTTP1:=TIdHTTP.Create(nil);
  IdSSLIOHandlerSocketOpenSSL1:=TIdSSLIOHandlerSocketOpenSSL.Create(nil);
  TmpList:=TStringList.Create;

  url:=Payment_url;
  SaveLog(ecr_no, '[傳入URL內容]:' url);

  try

    //攔截錯誤
    try

      try

        TmpList.Text:=ListIn_Data;


        //---------------------------------
        //打包 JSON
        //---------------------------------
        json:='{' 
              '"productName": "' TmpList.Values['productName'] '", ' 
              '"amount": "' TmpList.Values['amount'] '", ' 
              '"currency": "TWD", ' 
              '"orderId": "' TmpList.Values['orderId'] '", ' 
              '"oneTimeKey": "' TmpList.Values['oneTimeKey'] '"' 
              '}';
        JSONString := GetJSON(json);
        RequestBody := TStringStream.Create(JSONString.AsJSON);

        SaveLog(ecr_no, '[傳入資料內容]:' String(RequestBody.DataString));

        //---------------------------------
        //設定通訊元件
        //---------------------------------
        IdHTTP1.HandleRedirects:=true;
        IdHTTP1.ReadTimeout:=20000;
        //IdHTTP1.Port:=8080;

        //走 https 通信協定的話
        if (true) then begin
  IdSSLIOHandlerSocketOpenSSL1.SSLOptions.Method:=sslvTLSv1_2; //LinePay 要用到 TLS V1.2
            IdHTTP1.IOHandler:=IdSSLIOHandlerSocketOpenSSL1;
        end;

        //有無 Proxy
        if (Use_Proxy) then begin
            IdHTTP1.ProxyParams.ProxyServer:=ProxyServer;
            IdHTTP1.ProxyParams.ProxyPort:=ProxyPort;
        end;

        //參數中文不要自動 ENCODEING
        //IdHTTP1->HTTPOptions = IdHTTP1.HTTPOptions   [hoKeepOrigProtocol];
        IdHTTP1.HTTPOptions:=IdHTTP1.HTTPOptions - [hoForceEncodeParams];  //(同上功能)            //---------------------------------
        //製作 Request Header
        //---------------------------------
        IdHTTP1.Request.ContentType:='application/json';
        IdHTTP1.Request.ContentEncoding:='utf-8';
        IdHTTP1.Request.Accept:='application/json';

        IdHTTP1.Request.CustomHeaders.Add('X-LINE-ChannelId: ' Channel_ID);
        IdHTTP1.Request.CustomHeaders.Add('X-LINE-ChannelSecret: ' Channel_Secret);
        IdHTTP1.Request.CustomHeaders.Add('X-LINE-MerchantDeviceType: POS');
        IdHTTP1.Request.CustomHeaders.Add('X-LINE-MerchantDeviceProfileId: ' TmpList.Values['posId']);


        //---------------------------------
        //呼叫 Line API
        //---------------------------------
        json_out := IdHTTP1.Post(url, RequestBody, IndyTextEncoding_UTF8); //uses IdGlobal

        SaveLog(ecr_no, '[回傳資料內容]:' json_out);


        StrPCopy(ListOut_Data, JsonToListValues(json_out));
        SaveLog(ecr_no, '[解譯資料內容]:' String(ListOut_Data));

      finally
        RequestBody.Free;
      end;


    except
      on E: EIdHTTPProtocolException do begin
        rv:=999; //result 值

        //2018/04/18 ->
        //將 Exception 錯誤塞到 returnMessage 變數並回傳
        exception_message:=StringReplace(E.Message, Chr(13)   Chr(10), ';', [rfReplaceAll]);
        exception_message:=StringReplace(exception_message, ' ', '_', [rfReplaceAll]);
        StrPCopy(ListOut_Data, 'returnMessage=' exception_message);
        SaveLog(ecr_no, '[錯誤]:' String(ListOut_Data));
        //2018/04/18 <-
      end;
      on E: Exception do begin
        rv:=999; //result 值

        StrPCopy(ListOut_Data, 'returnMessage=' exception_message);
        SaveLog(ecr_no, '[錯誤]:' String(ListOut_Data));

      end;

    end;

  finally
    IdHTTP1.Free;
    IdSSLIOHandlerSocketOpenSSL1.Free;
    TmpList.Free;
  end;


  SaveLog(ecr_no, '○Call LP_Payment() End, result=' IntToStr(rv));

  result:=rv;

end;

編輯記錄

● Lazarus + Indy 處理 "電子發票取號" 的程式片段

1.有用過 INDY 的同學都知道, 要寫一個 TCP SERVER 要用到 IdTCPServer 這元件,
然後在其 IdTCPServer1Execute() 事件中處理各個 CLIENT 連線進來的執行緒
2.今天示範多個 POS 機連進來 IdTCPServer 要電子發票號碼的處理流程
比較特別的是 "發票取號" 的進入流程, 跟一般多個 Client 同時連進來的方式不大一樣
為保證同一時間不能有兩個以上的 Client 進來取到相同發票號碼
用到了 臨界區 的功能, 這樣可以保證取號動作是 "一個接著一個" 的處理

var
MyCs:TRTLCriticalSection;   //2018/01/17 臨界區

//------------------------------------------------------------------------------
procedure TForm1.FormCreate(Sender: TObject);  (Content)
begin
   InitCriticalSection(MyCs);  //2018/01/17 初始化臨界區
end;

//------------------------------------------------------------------------------
procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);  (Content)
begin
  DoneCriticalsection(MyCs); //2018/01/17 刪除臨界區
end;

//------------------------------------------------------------------------------
//2018/01/17
procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);  (Content)
var command_id:integer;
    command_tag:integer;
    command_text:  string ;
    command_text2:  string ;
    client_ip:string;
    result_str: string;
    MySync: TIdSync;
begin
  client_ip:=AContext.Connection.Socket.Binding.PeerIP;  //同 AContext.Binding.PeerIP;

  MySync:=TIdSync.Create();

  MySync.SynchronizeMethod(@IncrConnectioncount); //uses idsync; indy 10 要用這種寫法計算連線數

  try
    command_id:=AContext.Connection.IOHandler.ReadLongInt(true); //Command_Id => 1:SND_STR  2:GET_STR  3:SND_FILE  4:GET_FILE
    case command_id of
       1 : begin  //收到 SND_STR
           command_tag :=AContext.Connection.IOHandler.ReadLongInt(true); //需求_ID => 1:POS_CONNECT
           command_text:=AContext.Connection.IOHandler.ReadLn;  //POS_ID(機號)
           command_text2:=AContext.Connection.IOHandler.ReadLn;  //其他參數

           log_text:=client_ip '/'  command_text  ' (SND_STR): command_tag=' IntToStr(command_tag) ', command_text="' command_text '", command_text2="' command_text2;
       end;
       2 : begin  //收到 GET_STR
           command_tag :=AContext.Connection.IOHandler.ReadLongInt(true); //需求_ID => 1:TIME  2:發票取號
           command_text:=AContext.Connection.IOHandler.ReadLn; //POS_ID(機號)
           command_text2:=AContext.Connection.IOHandler.ReadLn;  //其他參數

           log_text:=client_ip '/'  command_text  ' (SND_STR): command_tag=' IntToStr(command_tag) ', command_text="' command_text '", command_text2="' command_text2;

           //----------------
           //取得 Server 時間
           //----------------
           if (command_tag=1) then begin
               AContext.Connection.IOHandler.WriteLn('SERVER TIME IS ' FormatDateTime('hh:nn:ss', Now));
           end;

           //----------------
           //發票取號
           //----------------
           if (command_tag=2) then begin
               result_str:='';
               EnterCriticalSection(MyCs); //進入臨界區(為了保證同一時間只有一個 Thread 取號)
               try
                   MySync.SynchronizeMethod(@CloseInvoPool);
                   result_str:=GetInvoRollStr(command_text, command_text2); //參數 : 機號, 卷數
                   MySync.SynchronizeMethod(@ShowInvoPool);
               finally
                   AContext.Connection.IOHandler.WriteLn(result_str);
                   LeaveCriticalSection(MyCs); //離開臨界區
               end;
           end;


           //---------------------------
           //2018/01/30 註記SC發票已使用
           //---------------------------
           if (command_tag=3) then begin
               result_str:='';
               //EnterCriticalSection(MyCs); //進入臨界區(為了保證同一時間只有一個 Thread 取號)
               try
                   MySync.SynchronizeMethod(@CloseInvoPool);
                   result_str:=SetInvoNoUsed(command_text, command_text2); //參數 : 機號, 發票年月 發票號
                   MySync.SynchronizeMethod(@ShowInvoPool);
               finally
                   AContext.Connection.IOHandler.WriteLn(result_str);
                   //LeaveCriticalSection(MyCs); //離開臨界區
               end;
           end;

           //-------------------------------
           //2018/01/30 查看SC發票是否已使用 (查看沒有互斥競爭問題, 應該不用設臨界區)
           //-------------------------------
           if (command_tag=4) then begin
               result_str:='';
               //EnterCriticalSection(MyCs); //進入臨界區(為了保證同一時間只有一個 Thread 取號)
               try
                   MySync.SynchronizeMethod(@CloseInvoPool);
                   result_str:=ChkInvoNoUsed(command_text, command_text2); //參數 : 機號, 發票年月 發票號
                   MySync.SynchronizeMethod(@ShowInvoPool);
               finally
                   AContext.Connection.IOHandler.WriteLn(result_str);
                   //LeaveCriticalSection(MyCs); //離開臨界區
               end;
           end;

           //-------------------------------
           //2018/01/31 查看發票卷在SC是否註記為該機領用 (查看沒有互斥競爭問題, 應該不用設臨界區)
           //-------------------------------
           if (command_tag=5) then begin
               result_str:='';
               //EnterCriticalSection(MyCs); //進入臨界區(為了保證同一時間只有一個 Thread 取號)
               try
                   MySync.SynchronizeMethod(@CloseInvoPool);
                   result_str:=ChkInvoRoll(command_text, command_text2); //參數 : 機號, 發票年月 發票號
                   MySync.SynchronizeMethod(@ShowInvoPool);
               finally
                   AContext.Connection.IOHandler.WriteLn(result_str);
                   //LeaveCriticalSection(MyCs); //離開臨界區
               end;
           end;


           //---------------------------
           //2018/02/09 電子發票查詢機能開發 - SC 查詢功能
           //---------------------------
           if (command_tag=6) then begin
               result_str:='';
               //EnterCriticalSection(MyCs); //進入臨界區(為了保證同一時間只有一個 Thread 取號)
               try
                   MySync.SynchronizeMethod(@CloseInvoPool);
                   result_str:=EInvo_DataLoad2(command_text, command_text2); //參數 : 機號, "交易日期/查詢欄位/查詢值"
                   MySync.SynchronizeMethod(@ShowInvoPool);
               finally
                   AContext.Connection.IOHandler.WriteLn(_StrToHex(result_str)); //多行字串之特別處理
                   //LeaveCriticalSection(MyCs); //離開臨界區
               end;
           end;           end;
    end;
  finally
    AContext.Connection.Disconnect();

    //2018/05/15 搬進這裡, 連線數扣減才有效, ??
    MySync.SynchronizeMethod(@DecrConnectioncount); //uses idsync; indy 10 要用這種寫法計算連線數
    MySync.Free;
  end;

  //MySync.Free;

end;

● Lazarus 製作 dll 的做法

1.透過以下範例用 lazarus 撰寫 dll 中的函式
2.透過 pchar 做參數傳遞比較通用, 也比較不會有問題
3.透過 Borland 的 IMPLIB LazLinePay.lib LazLinePay.dll
將 dll 檔變成 Borland 的 lib 檔 (LazLinePay.dll -> LazLinePay.lib)

//---------------------------------------------------------------------------
//LazLinePay.lpr (LazLinePay.dll 的 Lazarus 專案檔, 編譯後就是 LazLinePay.dll)
//---------------------------------------------------------------------------
library LazLinePay;

{$mode objfpc}{$H }

uses
..............

var
..............

//---------------------------------------------------------------------------
//LinePay-付款功能(POST)
function LP_Payment(ecr_no: pchar; ListIn_Data: pchar; ListOut_Data: pchar): integer; stdcall;
begin
//程式碼(略)
end;

//---------------------------------------------------------------------------
//LinePay-付款狀態查詢(GET)
function LP_PaymentStatus(ecr_no: pchar; ListIn_Data: pchar; ListOut_Data: pchar): integer; stdcall;
begin
//程式碼(略)
end;

//---------------------------------------------------------------------------
//LinePay-作廢功能(POST)
function LP_Void(ecr_no: pchar; ListIn_Data: pchar; ListOut_Data: pchar): integer; stdcall;
begin
//程式碼(略)
end;

//---------------------------------------------------------------------------
//LinePay-退款功能(POST)
function LP_Refund(ecr_no: pchar; ListIn_Data: pchar; ListOut_Data: pchar): integer; stdcall;
begin
//程式碼(略)
end;

//---------------------------------------------------------------------------
//LinePay-請款功能(POST)
function LP_Capture(ecr_no: pchar; ListIn_Data: pchar; ListOut_Data: pchar): integer; stdcall;
begin
//程式碼(略)
end;

//---------------------------------------------------------------------------
//LinePay-查看付款授權(未請款)記錄(GET)
function LP_Authorization(ecr_no: pchar; ListIn_Data: pchar; ListOut_Data: pchar): integer; stdcall;
begin
//程式碼(略)
end;


//---------------------------------------------------------------------------
//LinePay-查看付款(已請款)記錄(GET)
function LP_PaymentDetails(ecr_no: pchar; ListIn_Data: pchar; ListOut_Data: pchar): integer; stdcall;
begin
//程式碼(略)
end;

//---------------------------------------------------------------------------
//最後要加這個
exports LP_Payment, LP_PaymentStatus, LP_Void, LP_Refund, LP_Capture, LP_Authorization, LP_PaymentDetails;


end.

● BCB 5.0 呼叫 Lazarus 製作的 dll 的做法

1.BCB 5 專案加入 LazLinePay.lib (靜態連結方式)

2.*.H 檔中加入以下宣告檔
extern "C"{

int __stdcall LP_Payment(char *ecr_no, char *ListIn_Data, char *ListOut_Data);
int __stdcall LP_PaymentStatus(char *ecr_no, char *ListIn_Data, char *ListOut_Data);
int __stdcall LP_Void(char *ecr_no, char *ListIn_Data, char *ListOut_Data);
int __stdcall LP_Refund(char *ecr_no, char *ListIn_Data, char *ListOut_Data);
int __stdcall LP_Capture(char *ecr_no, char *ListIn_Data, char *ListOut_Data);
int __stdcall LP_Authorization(char *ecr_no, char *ListIn_Data, char *ListOut_Data);
int __stdcall LP_PaymentDetails(char *ecr_no, char *ListIn_Data, char *ListOut_Data);
}

3.呼叫 DLL 中的函式例

//付款狀態查詢
void __fastcall TForm1::Button1Click(TObject *Sender)
{
int rr=0;
String ecr_no="1234";

Memo2->Lines->Clear();

try
{
char ListIn_Data[1024];
char ListOut_Data[1024];
memset(ListIn_Data, 0, sizeof(ListIn_Data));
memset(ListOut_Data, 0, sizeof(ListOut_Data));

StrPCopy(ListIn_Data, Memo3->Lines->Text); //將 Memo3 內容傳入 ListIn_Data

rr = LP_PaymentStatus(ecr_no.c_str(), ListIn_Data, ListOut_Data); //呼叫 DLL 中的 LP_PaymentStatus()

ShowMessage("通訊DLL回收 rr=" IntToStr(rr));

Memo2->Lines->Text=ListOut_Data; //將函式取回值 放入 Memo2


}
catch(Exception &E)
{
ShowMessage("★執行錯誤 : " E.Message);
}
}

這兩天有更新版本了 1.8.4

● Lazarus 當漏
https://www.lazarus-ide.org/

編輯記錄

[一些發想]

1.使用 Lazarus 時的快速方便, 讓我有一些時間花在應用及發想上面, 而不是花時間研究永遠追不上的高深技術上,
RAD TOOLS 不就是用來快速開發我們要用的功能嗎 ? 新的 Dephi/BCB 搞的像學術界裡頂尖的程式語言,
我們到底是學校裡的碩博士生, 還是要工作養家的勞工 ?
如果 CLIPPER 跟 FOXPRO 還在, 會有人把 IT 最新技術加到裡面嗎 ? 應該沒必要

2.之前為了做一個圖片播放程式, 先寫一了個圖片縮小程式, 把圖片 SIZE 縮為螢幕大小後丟到一個目錄去,
然後再寫一支播放程式, 放到圖片目錄中執行就會自動播放, 還有轉場特效
後來發想到, 何不把兩支程式結合為一支程式, 執行這程式主要功能是縮圖, 批次縮完圖後, 同時把自己(*.EXE)複製並改名
COPY 到縮圖目錄中, 這樣縮圖目錄中有縮好的圖, 還有一支播放程式執行檔
我怎麼控制這程式單獨讀執行時是縮圖程式(有畫面跟縮圖選項操作), 在圖片目錄中執行就直接播放圖片呢 ?
很簡單, 程式檔名, 同支程式, 啟動時發現自己叫 A.EXE 就進入縮圖程式相關功能,
啟動時發現自己叫 B.EXE 就進入PLAY 程式相關功能
這創意很簡單, 但應該沒幾個人這樣做過, 這就是發想

3.十幾年前跟外包廠商配合, 弄了一套 ASP 寫的後台 WEB 系統給客戶用, 客戶很節儉, 系統用了十幾年都沒換,
WEB 程式也沒有人可維護, 因為開發工具太老舊, 還用到一些外掛原件,
想想 ...WEB 程式也是一直有版本相容性問題, 瀏覽器換了要改版, .NET 平台換了也要改版,
IT 人員常常把心思花在技術升級上, 而不是系統本身的商業邏輯修改上
如果是一些 WEB 程式簡單運用, 如後台銷售業績分析之類的頁面, 同時不會超過二十個人連入
應該可以用 INDY 的 WEB SERVER 元件來做到, 以前寫過 CGI 程式,
我的想法, CGI 是掛在別人的 WEB SERVER 下執行 (如 IIS 或阿帕契)
而使用INDY 的 WEB SERVER 元件, 則是可以把 CGI 要寫的東西跟 INDY WEB SERVER 整合在一起
(WEB SERVER 跟 CGI 都自己處理)
好好規劃架構, 也許能寫出更複雜的程式(進銷存 ??), 使用簡單單純的東西就沒那麼多相容性問題

編輯記錄

[繼續發想]

1.以前用記事本寫過 HTML, 知道原來將資料加上那些 TAG, 就可以打包成 HTML 在瀏覽器中呈現,
後來在工作應用上, 要對畫面上的交易明細資料(StringGrid呈現)除錯, 實際上每一列交易 ITEM
不是只有 UI 上看得到的那些欄位, 背後還有一些看不到的欄位, 用來儲存每筆 ITEM 的組合促銷
關聯資訊, 還有各種折扣參數, 一個 ITEM 將近有三十個欄位, 除錯時我需要把整個二維資料倒出來
監看它各欄位值消長的變化值, 我不知道用甚麼 DEBUG 工具可以一窺二維陣列資料的 "全貌"
只想到滑鼠右鍵, 在 POPUPMENU 加個功能, 繞迴圈把整個二維資料加上 TAG
另存到外部 *.HTML 檔, 從外部監看這個 HTML 檔(用 GRID 格式呈現)就能一窺整個二維陣列資料的全貌
不知道現在大家都用工具產生 HTML 檔, 有多少人還在自己編制 HTML 檔....XD

2.前陣子寫 LinePay 支付, 要用到 JSON 格式, 心裡很 XX, IT 界發展出這麼多新格式是有比較厲害嗎 ?
用了二十年的 BCB 5 哪來拆解 JSON 的函式可用 ? 只好自己寫函式去拆解, JSON 不過就是個文字格式,
我會被一個文字格式打敗嗎 ? 研究了一下 JSON 中那些括弧及層級結構, 知道括弧是有對稱性的
又是利用迴圈, 逐字讀入 JSON 資料, 然後把 "層" 攤平(像 INI 格式), 就可以讀取資料了,
給沒有相關類庫就不會寫程式的人一些發想

{"returnCode":"0000",
"returnMessage":"Success.",
"info":[ { "transactionId":2018041700025864011,
"transactionDate":"2018-04-17T00:26:51Z",
"transactionType":"PAYMENT_REFUND",
}
]
}

變成
returnCode=0000
returnMessage=Success.
info_transactionId=2018041700025864011
info_transactionDate=2018-04-17T00:26:51Z
info_transactionType=PAYMENT_REFUND

JSON 不是「新格式」，在 1999 年就提出來了，但廣泛使用是 AJAX 流行之後的事

------
歡迎參訪 "腦殘賤貓的備忘錄" http://maolaoda.blogspot.com/

有一些以穩健穩定為前提的軟體, 通常不會跟著開發工具版本及平台的演進, 或許如機器設備軟體、會計系統及銀行的系統, 不過這只是整體產業的百分之幾, 如能待在這樣的環境或許就不用耗掉太多時間跟著新穎技術?

這裡有google到關於lazarus的文章, 或許對你學習上有幫助
http://blog.xuite.net/boba543/blog

===================引 用 lazarus 文 章===================

1.使用 Lazarus 時的快速方便, 讓我有一些時間花在應用及發想上面, 而不是花時間研究永遠追不上的高深技術上,
RAD TOOLS 不就是用來快速開發我們要用的功能嗎 ? 新的 Dephi/BCB 搞的像學術界裡頂尖的程式語言,
我們到底是學校裡的碩博士生, 還是要工作養家的勞工 ?
如果 CLIPPER 跟 FOXPRO 還在, 會有人把 IT 最新技術加到裡面嗎 ? 應該沒必要

感謝長官, 這部落格不錯

[ Lazarus 連結 Oracle 的問題 ]

這兩天測試用 XP (Lazarus 1.6.4 內建 Oracle 元件 OracleConnection1) 來連另一台電腦上的 Oracle 10.0.2 DB
遇到一些問題, 搞了兩天終於搞定, 分享一下, 避免有人遇到跟我一樣情形
(之前連過 MS SQL 及 SQLLITE ... 都很順, 就只有連 Oracle 不順利)


前情提要
1.Client 端是 XP 電腦, 也是開發程式的電腦, 有灌了 Lazarus 開發工具 及 Oracle Client
2.有建了 udl 檔來測試 Oracle 連線, 確定可以連到另一台電腦上的 Oracle 10.0.2 DB
3.BCB 5.0 ADO , 也能從這台 XP 連到另一台電腦上的 Oracle 10.0.2 DB
4.Lazarus 1.6.4 內建 Oracle 元件 OracleConnection1 就是無法連, 出現 ORA-12154: TNS: 無法解析指定的連線 ID

5.後來換了 ZEOS 元件, 仍然無法連, 一樣是 ORA-12154 , 所以不是元件問題, 但我百思不解, 明明 udl 檔來測試 Oracle 連線是通的
6.無意間發現, 在 Lazarus IDE 環境中, 設計時期把 Object Inspector 上的 OracleConnection1 或 ZConnection1 元件相關屬性設好
再把其 Connected 設成 true , 居然可以連, 但在編譯後的執行時期, 一到 Connected:=true 的階段, 都是 ORA-12154


解決方案
1.到網路搜尋相關問題, 似乎都沒有對策
2.有人說換掉 Oracle Client, 因為已經沒步了, 姑且一試
把 OracleClient_10.2.0.1 換成 OracleClient_11.2.0 , 結果正常了
網路說高一點的 OracleClient 版本可連低版本資料庫 (Oracle 10g)
3.看起來跟 Oracle Client 有關, 跟 Lazarus 元件及版本無關
但其他程式語言又沒這問題, 可能 OracleClient_10.2.0.1 跟 Lazarus 相剋 ....XD
4.換成 OracleClient_11.2.0 後, Lazarus 內建的 OracleConnection1 & ZConnection1 都能在執行時期正常連 Oracle



補充註記
1.使用 Lazarus 內建的 OracleConnection1 或 ZOES 元件, 都需要安裝 Oracle Client
2.另有一種要錢的元件叫 ODAC ( https://www.devart.com/odac/download.html )
聽說可以不用安裝 Oracle Client 元件就能直接連 Oracle DB
3.以下為 內建的 OracleConnection1 或 ZOES 元件, 測試 OK 的 SAMPLE
Oracle DB 在另一台電腦 IP:192.168.5.12 SID 名稱叫 dream
XP 開發電腦(本機)安裝 Oracle Client 後, 在 NetManager 中設了一服務名稱 niceapdb
其實服務名稱 niceapdb 也是指到 IP:192.168.5.12 SID:dream
所以 DatabaseName 屬性有兩種設法, 一是直接設 'niceapdb' 一是設為 '192.168.5.12/dream'


測試 OK , 中文欄位亂碼
//OracleConnection1.HostName := ''; //在 ide design 模式測試發現可以不設
//OracleConnection1.DatabaseName := '192.168.5.12/dream'; //直接聯資料庫所在 IP/SID, OK
OracleConnection1.DatabaseName := 'niceapdb'; //with NetManager setup , OK
OracleConnection1.UserName := 'sa';
OracleConnection1.Password := 'sa123';
//OracleConnection1.Params.Add('codepage=UTF8'); //沒作用
OracleConnection1.Open;
SQLQuery1.PacketRecords:=-1;
SQLQuery1.SQL.Text:='SELECT * FROM "OIS"."PSM_CASHIER"';
SQLQuery1.Active:=true; //SELECT * FROM "OIS"."PSM_CASHIER"
DataSource1.DataSet:=SQLQuery1;


//測試 OK , 中文欄位正常顯示
//ZConnection1.HostName := '' ; //在 ide design 模式測試發現可以不設
ZConnection1.Port := 1521 ;
//ZConnection1.Database := '192.168.5.12/dream'; //直接聯資料庫所在 IP/SID, OK
ZConnection1.Database := 'niceapdb'; //with NetManager setup, OK
ZConnection1.User := 'sa' ;
ZConnection1.Password := 'sa123' ;
ZConnection1.Protocol := 'oracle' ;
ZConnection1.Connected:=true;
ZQuery1.FetchRow:=0;
ZQuery1.SQL.Text:='SELECT * FROM "OIS"."PSM_CASHIER"';
ZQuery1.Active:=true;
DataSource1.DataSet:=ZQuery1;

編輯記錄

DELPHI 之 LBBUTTON 元件修改 for Lazarus
一. 可在 Lazarus 1.8.4 32 位元安裝
二. Caption 可用中文
三. LbSpeedButton 的 Style 初始值為 bsModern (水晶樣式)



下載 : http://www.fpccn.com/forum.php?mod=attachment&aid=MjEyN3xhOWE2MjhjOHwxNTI5MzI0NDAxfDE5OTB8MjI1NjE=

編輯記錄

新文字文件.html

主題 : 單色點陣圖 bmp 轉 Epson 熱感式發票印表機使用的 bin 檔 (直接拆解單色點陣圖 bmp, 不用透過 API)

關鍵字 : BmpToRaster, bmp to epson Thermal Printer, 電子發票印 LOGO 圖檔


type
ByteArray  = array of byte;    procedure TForm1.Button1Click(Sender: TObject);
var fn_bmp: string;
    bin_data: ByteArray;
    bin_length: integer;
    strm: TFileStream;
begin

  //須為單色點陣圖 bmp
  fn_bmp:='c:\test.bmp'; //mono bmp


  //-----------------------------------------------------------------------------------
  //直接列印, 丟入 com port 元件直接從 epson Thermal Printer 如 TM-T82II 列印 logo 圖檔
  //-----------------------------------------------------------------------------------
  _GetBinDataFromBmp(fn_bmp, bin_data, bin_length);
  SdpoSerial1.WriteBuffer(bin_data[0], bin_length); //傳入 buffer 要加 [0]


  //-----------------------------------------------------------------------------------
  //轉出 bin 檔, 下次可直接載入列印, 或燒錄到 TM-T82II 內建 VM 中
  //-----------------------------------------------------------------------------------
  strm := TFileStream.Create('c:\test.bin'), fmCreate or fmOpenWrite);
  strm.WriteBuffer(bin_data[0], bin_length);
  strm.Free;      SetLength(bin_data, 0);

end;    //取得 bmp 檔之 Bin data 資料, 放入 bin_data 回傳
procedure TForm1._GetBinDataFromBmp(fn_bmp:string; var bin_data: ByteArray; var bin_length: integer);
var strm: TFileStream;
    n: longint;
    bmp_data: array of Byte;

    //bin_data: array of Byte; //bin 身
    ESC_CMD: array of Byte;

    biWidth: integer;    //bmp 圖檔寬度
    biHeight: integer;
    biPlanes: integer;
    biBitCount: integer;
    W: integer; //列寬 bytes 數

    i: integer;
    x: integer;
    y: integer;
    sour_addr: integer;
    dest_addr: integer;
    last_img_data_bit: integer; //最後一 byte 圖檔資料的 bit 數

    xl: integer;
    xh: integer;
    yl: integer;
    yh: integer;
begin

  strm := TFileStream.Create(fn_bmp, fmOpenRead or fmShareDenyWrite);
  try
      n := strm.Size;
      SetLength(bmp_data, n);

      strm.Read(bmp_data[0], n);


      biWidth:=Ord(bmp_data[19])*256 Ord(bmp_data[18]);
      biHeight:=Ord(bmp_data[23])*256 Ord(bmp_data[22]);

      //若以下兩個值不是 1, 就不是單色 bmp
      biPlanes:=Ord(bmp_data[26]);
      biBitCount:=Ord(bmp_data[28]);

      if (biPlanes<>1) or (biBitCount<>1) then ShowMessage('非單色圖檔');


      W:=Trunc((biWidth   7) / 8); //列寬 bytes 數 = 大於 biWidth 的最小之八的倍數

      SetLength(bin_data, W*biHeight);

      dest_addr:=0;
      for y := biHeight downto 1 do begin
        for x := 1 to W do begin
            sour_addr := (y - 1) * W   x - 1;
            sour_addr := sour_addr   62;

            if (dest_addr <> 0) and (((dest_addr   1) mod W) = 0) then begin
                //每列最後(右)一個 byte 要特別處理 (因為最後(右)一個不是 8 個 bit 都是圖檔資料)
                last_img_data_bit:=(biWidth mod 8); //最後一 byte 圖檔資料的 bit 數

                case last_img_data_bit of
                    0: begin
                       bin_data[dest_addr]:=not bmp_data[sour_addr];
                    end;

                    1: begin
                       bin_data[dest_addr]:=not (bmp_data[sour_addr] or $7F); //or 01111111
                    end;

                    2: begin
                       bin_data[dest_addr]:=not (bmp_data[sour_addr] or $3F);  //or 00111111
                    end;

                    3: begin
                       bin_data[dest_addr]:=not (bmp_data[sour_addr] or $1F);  //or 00011111
                    end;

                    4: begin
                       bin_data[dest_addr]:=not (bmp_data[sour_addr] or $0F);  //or 00001111
                    end;

                    5: begin
                       bin_data[dest_addr]:=not (bmp_data[sour_addr] or $07);  //or 00000111
                    end;

                    6: begin
                       bin_data[dest_addr]:=not (bmp_data[sour_addr] or $03);  //or 00000011
                    end;

                    7: begin
                       bin_data[dest_addr]:=not (bmp_data[sour_addr] or $01);  //or 00000001
                    end;

                end;

            end else begin
                bin_data[dest_addr]:=not bmp_data[sour_addr];
            end;

            dest_addr := dest_addr   1;
        end;
      end;


      xl := W mod 256;             //xL
      xh := Trunc(W / 256);        //xH
      yl := biHeight mod 256;      //yL
      yh := Trunc(biHeight / 256); //yH


      SetLength(ESC_CMD, W*biHeight   8);

      ESC_CMD[0] := 29;   //1D
      ESC_CMD[1] := 118;  //76
      ESC_CMD[2] := 48;   //30
      ESC_CMD[3] := 0;
      ESC_CMD[4] := xl;
      ESC_CMD[5] := xh;
      ESC_CMD[6] := yl;
      ESC_CMD[7] := yh;

      for i := 0 to (W*biHeight)-1 do begin
          ESC_CMD[8   i] := bin_data[i];
      end;


      //將 ESC_CMD[] 資料回寫 bin_data[]
      SetLength(bin_data, W*biHeight   8);
      bin_length:=Length(bin_data);
      for i := 0 to (W*biHeight   8)-1 do begin
          bin_data[i]:=ESC_CMD[i];
      end;


  finally
    SetLength(bmp_data, 0);
    //SetLength(bin_data, 0);
    SetLength(ESC_CMD, 0);

    strm.Free;
  end;    end;

編輯記錄

Lazarus 讀寫 PLC 範例 (MC 協議)

http://lazarus.freebbs.tw/viewthread.php?tid=111&extra=page=1

編輯記錄

編輯記錄

■ 以 Lazarus Indy/TIdHTTP 實作 WebSocket Client 端通訊機制


● 前言

1.公司 POS 專案需要用 WebSoxket 通訊協定連接一家手機點餐的系統, 以便獲取訂單通知資訊
2.找不到好用的 for Lazarus 之 WebSoxket 元件, 不然就是不支援 SSL (Server 端要求使用 wss 協定)
3.知道 WebSocket 是 http 的 Upgrade 版本, 只好土法煉鋼, 用 https 來實作 WebSoxket SSL (wss) 協定
4.本範例只是實作證明, 用 Indy/TIdHTTP 可以模擬出 WebSoxket 通訊協定; 實用上要把相關功能放在另一個 Thread 內
不然主執行緒會被 hold 住 (因為 http 通訊內用了一個 while do 的無窮迴圈)




● Server 端要求的連線方式

連線方式
wsocket_protocol=wss
wsocket_host=wsocket-test.mydomain.shop
wsocket_port=443


登入驗證：連線時帶入Header「Authorization」，值為HTTP基本認證格式。
1.編碼方式：將「帳號:密碼」進行Base64編碼。
2.範例：當帳號為「username」，密碼為「password」時，對應Header的值為 「Basic dXNlcm5hbWU6cGFzc3dvcmQ=」。
3.驗證失敗時會回傳特定HTTP狀態碼並中止連線：
(1) 401：缺少Header「Authorization」或是header內容錯誤
(2) 403：帳號或密碼錯誤

心跳機制：每隔30秒伺服器端會發送訊息，客戶端需回傳對應訊息以保持連線建立。
1.伺服器端傳送格式：「"primus::ping::"」，其中 為目前時間戳記。
2.客戶端回傳格式：「"primus::pong::"」，其中為 「伺服器端傳來的時間戳記」。*注意：包含「"」
3.範例：伺服器端傳送「"primus::ping::1523519829084"」時，客戶端需回傳訊 息「"primus::pong::1523519829084"」


[code delphi]


● 實作 (程式碼中有 ★★ 者為重點)

//使用 HTTPS 來模擬實作 WSS (WebSocket over SSL)
procedure TForm1.Button1Click(Sender: TObject);
var RequestStr: string;
ResponseStr: string;
RequestBody: TStringStream;
IdHTTP1: TIdHTTP;
IdSSLIOHandlerSocketOpenSSL1: TIdSSLIOHandlerSocketOpenSSL;
i: integer;
Ib: TIdBytes;
begin


WebSocket_stop:=0;

IdHTTP1:=TIdHTTP.Create(nil);
IdSSLIOHandlerSocketOpenSSL1:=TIdSSLIOHandlerSocketOpenSSL.Create(nil);

try
try
//---------------------------------
//打包 JSON 或一般字串
//---------------------------------
RequestStr:=''; //走 IdHTTP1.Get() 方法, 不需用到


RequestBody := TStringStream.Create(RequestStr);


//---------------------------------
//設定通訊元件
//---------------------------------
IdHTTP1.HandleRedirects:=true;
IdHTTP1.ReadTimeout:=40000;
IdHTTP1.ConnectTimeout:=40000;


//走 https 通信協定
IdSSLIOHandlerSocketOpenSSL1.SSLOptions.Method:=sslvTLSv1_2; //LinePay 要用到 TLS V1.2
IdHTTP1.IOHandler:=IdSSLIOHandlerSocketOpenSSL1;

//有 Proxy 時
//IdHTTP1.ProxyParams.ProxyServer:=ProxyServer;
//IdHTTP1.ProxyParams.ProxyPort:=ProxyPort;

//參數中文不要自動 ENCODEING
//IdHTTP1.HTTPOptions := IdHTTP1.HTTPOptions [hoKeepOrigProtocol];
IdHTTP1.HTTPOptions:=IdHTTP1.HTTPOptions - [hoForceEncodeParams]; //(同上功能)


//-----------------------------------------------------------------
//製作 Request Header (★★ 把 HTTP Upgrade 為 WEBSocket 通訊協定 )
//-----------------------------------------------------------------
IdHTTP1.Request.Connection := 'keep-alive';
IdHTTP1.Request.ContentType := 'text/plain; charset=UTF-8'; //UTF-8
IdHTTP1.Request.Connection := 'Upgrade';

IdHTTP1.Request.CustomHeaders.Clear;
IdHTTP1.Request.CustomHeaders.Add('Authorization: Basic dXNlcm5hbWU6cGFzc3dvcmQ=');

//沒加這段, 會有 => (錯誤)HTTP/1.1 426 Upgrade Required
IdHTTP1.Request.CustomHeaders.Add('GET / HTTP/1.1');
IdHTTP1.Request.CustomHeaders.Add('Host: wsocket-test.mydomain.shop:443');
IdHTTP1.Request.CustomHeaders.Add('Connection: Upgrade');
IdHTTP1.Request.CustomHeaders.Add('Upgrade: websocket');
IdHTTP1.Request.CustomHeaders.Add('Sec-WebSocket-Version: 13');
IdHTTP1.Request.CustomHeaders.Add('Sec-WebSocket-Key: dXNlcm5hbWU6cGFzc3dvcmQ='); //與 "後面服務端" 響應首部的Sec-WebSocket-Accept 是配套的，提供基本的防護，比如惡意的連接，或者無意的連接。


//---------------------------------
//呼叫 IdHTTP1.Get()
//---------------------------------

ResponseStr:=IdHTTP1.Get('https://wsocket-test.mydomain.shop:443');


if IdHTTP1.Response.ResponseCode = 101 then begin
Memo2.Lines.Add('Upgrade was accepted, use IdHTTP1.IOHandler to process WebSocket packets as needed ...'); //監看

//★★ 建立持續的連線, 以及處理心跳包機制
while true do begin
Application.ProcessMessages;
if WebSocket_stop=1 then break; //讓 while 迴圈停止的機制

//收信
SetLength(Ib, 0);
IdHTTP1.IOHandler.ReadBytes(Ib, -1);
Memo2.Lines.Add(BytesToString(Ib)); //監看


if Pos('ping', BytesToString(Ib))>0 then begin
//收到 ping, 回傳 pong
Ib[12] := $6f; //'o' ...//把收到的 "primus::ping::1604037836730" 改成 "primus::pong::1604037836730"
Memo2.Lines.Add(BytesToString(Ib)); //監看
IdHTTP1.IOHandler.Write(Ib, -1);
else else begin
Memo2.Lines.Add(BytesToString(Ib)); //監看其他資料
end;

end;


Memo2.Lines.Add('WebSocket Stop!!'); //監看


end else begin
Memo2.Lines.Add('Upgrade was not accepted ...'); //監看
end;




RequestBody.Free;

except
on E: Exception do begin
Memo2.Lines.Add('(錯誤)' E.Message); //監看
end;
end;
finally
IdHTTP1.Disconnect;
IdHTTP1.Free;
IdSSLIOHandlerSocketOpenSSL1.Free;
end;





end;
[/code]