最近用Delphi編寫DLL比較多，總結幾條經驗方便以後回顧。

需求背景：DLL介面自身是向主調方提供服務，考慮到主調方的不定性以及響應速度問題，需要支援多執行緒。

實現思路：DLL在初次載入或者被喚醒的時候會呼叫DLLMain函式(Delphi的Main函式頭已被隱藏，實際上就是主檔案中的Begin End)，觸發DLL_Process_Attach事件。可用全域性變數DLLProc來處理觸發的事件所呼叫的函式。

DLL在退出的時候會呼叫DLLMain函式(Delphi的Main函式頭已被隱藏，實際上就是主檔案中的Begin End)，觸發DLL_Process_Detach事件。可用全域性變數ExitProc

Delphi原始碼如下：

var

  OldExitProc:pointer;


begin

    DLLProc:[email protected];//由於DLLProc原事件已經執行完成，此處可以不再儲存原事件

    MyDLLHandler(DLL_Process_Attach);//執行自定義方法

 

    OldExitProc:=ExitProc;//暫存退出後處理函式地址

    ExitProc:[email protected]; //讓系統呼叫自定義函式處理事情，在MyExitProc中需要賦值回來。

end.

 

為了限制不同時執行某些關鍵區域，使用Delphi Windows下的CriticalSection

在DLL對映時建立，在介面中運用Enter、Leave，在退出時銷燬

var
  FSection: TRTLCriticalSection;//定義一個關鍵區域用於執行緒互斥執行
//關鍵區域進出
procedure Enter(OutType:string);
begin
  _log('Enter FSection',OutType);
  EnterCriticalSection(FSection);
end;

procedure Leave(OutType:string);
begin
   _log('Leave FSection',OutType);
   LeaveCriticalSection(FSection);
end;
//關鍵區域使用
procedure MyDLLHandler(Reason: integer);
begin
  case Reason of
    DLL_Process_Attach: //整個DLL的初始化程式碼
      begin
          _log('DLL_Process_Attach', 'FSection');
          InitializeCriticalSection(FSection);
      end;
    DLL_Process_Detach: //整個DLL的善後程式
      begin
        DeleteCriticalSection(FSection);
        _log('DLL_Process_Detach', 'FSection');
      end;
    DLL_Thread_Attach: //當主叫端開始一個Thread時
      begin
        _log('DLL_Thread_Attach', 'FSection');
        StartMyThreadsAndWaitBegin();
      end;
    DLL_Thread_Detach: //當主叫端終止一個Thread時
      begin
        _log('DLL_Thread_Detach', 'FSection');
        StopMyThreadsAndWaitEnd();
      end;
  end;
end;
procedure MyExitProc;
begin
  _log('MyExitProc','FSection');
  ExitProc:=OldExitProc;//恢復退出的事件
end;

procedure StartMyThreadsAndWaitBegin();
begin
  _log('StartMyThreadsAndWaitBegin','FSection');
  Exit;
end;

procedure StopMyThreadsAndWaitEnd();
begin
  _log('StopMyThreadsAndWaitEnd','FSection');
  Exit;
end;
 

關鍵區域在介面中運用舉例：

{
   created by: JustinYang 2016-09-23
   function: 托盤解綁
   Param in: Ahandle窗體控制代碼, serverIP 訪問伺服器IP,serverPort 伺服器埠,s_TrayID 托盤編號,i_TrayRFID 托盤RFID
   Param Out: 整型 -1 網路異常；-2 托盤編號長度不對; -3 RFID大小異常; 1 解綁成功 0 解綁不成功 
}
function upFreeTray(AHandle: THandle; serverIP: PChar; serverPort: integer; s_TrayID:PChar; i_TrayRFID:Int64): integer; export; stdcall;
var
  p_serverIP: string;
  P_serverPort,j: Integer;
  tOld,tNew:TDateTime;
  trayID:string;
  trayRFID:Int64;
  hw:Integer;
begin
  try
    try
      Enter('FSection');

      j:=-1;
      result:=j;
      _log(' IP:'+serverIP+' Port:'+IntToStr(serverPort),'upFreeTray');
      if Length(string(s_TrayID)) <3 then s_TrayID :='';
      _log(' Begin upFreeTray IP:'+serverIP+' Port:'+IntToStr(serverPort)+' Tray:'+IntToStr(i_TrayRFID)+':'+s_TrayID+' at '+DateTimeToStr(Now),'upFreeTray');     

      CoInitialize(nil);
      Application.handle := AHandle;
      
      trayID:=string(s_TrayID);
      trayRFID:=i_TrayRFID;
      if (Trim(trayID)='') and (trayRFID <= 0) then
      begin
        _log(' End upFreeTray '+IntToStr(trayRFID)+':'+trayID+'  at '+ DateTimeToStr(Now) + ' result:'+IntToStr(j),'upFreeTray');
        result:=0;
        Exit;
      end;

      DllDataModule := TDllDataModule.Create(Application);


      p_serverIP := string(serverIP);
      if serverPort <= 0 then
        P_serverPort := 8095
      else
        P_serverPort := serverPort;
      DllDataModule.Channel.Host := string(p_serverIP);
      DllDataModule.Channel.Port := P_serverPort;
    except
      on e:Exception do
      begin
          j := -1;//網路連線失敗
          _log('When dll access network occours:'+e.Message,'upFreeTray');
          Exit;
      end;
    end;
    try
       j := ((DllDataModule.RemoteService as INewService).upFreeTray(trayID, trayRFID));
       if j > 0 then j := 1;
    except
      on e:Exception do
      begin
        j:=-4;
        _log('When dll access server occours:'+e.Message,'upFreeTray');
        Exit;
      end;
    end;
  finally
    DllDataModule.free;
    result:=j;
    _log(' End upFreeTray '+IntToStr(i_TrayRFID)+' '+s_TrayID+'  at '+ DateTimeToStr(Now) + ' result:'+IntToStr(j),'upFreeTray');
    CoUninitialize;
    Leave('FSection');
  end;
end;