ubuntu下用lz写纯正的socket守护程序

渔夫

Program filesrv;
Uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
  CThreads,
{$ENDIF}{$ENDIF}
  DaemonApp, lazdaemonapp, daemonmapperfilesrv, daemonfilesrv
  { add your units here };
begin
  Application.Initialize;
  Application.Run;
end.
------------------------------------------------------------------------------------------
unit daemonmapperfilesrv;
{$mode objfpc}{$H+}
interface
uses
  Classes, SysUtils, FileUtil, DaemonApp;

type
  TDaemonMapper1 = class(TDaemonMapper)
  private
    { private declarations }
  public
    { public declarations }
  end;
var
  DaemonMapper1: TDaemonMapper1;
implementation
procedure RegisterMapper;
begin
  RegisterDaemonMapper(TDaemonMapper1)
end;
{$R *.lfm}
initialization
  RegisterMapper;
end.
------------------------------------------------------------------
unit daemonfilesrv;
{$mode objfpc}{$H+}
interface
uses
  Classes, SysUtils, FileUtil, DaemonApp, Sockets, IniFiles, Math;
const
  INVALID_Socket = -1;
  SOCKET_ERROR = -1;

type
  TNetConfig = record
    IP, LogPath: string;
    Port: Integer;
  end;
type
  TServerThread = class(TThread)
  private
    FServer: TSocket;
  public
    procedure Execute; override;
    constructor Create(CreateSuspended: Boolean; ParentSock: TSocket);
  end;

type
  TDaemon1 = class(TDaemon)
    procedure DataModuleStart(Sender: TCustomDaemon; var OK: Boolean);
    procedure DataModuleStop(Sender: TCustomDaemon; var OK: Boolean);
  private
    FSvr: TSocket;
    ServerThread: TServerThread;
    function GetConfig: TNetConfig;
  public
  end;
var
  Daemon1: TDaemon1;
implementation

procedure RegisterDaemon;
begin
  RegisterDaemonClass(TDaemon1)
end;
constructor TServerThread.Create(CreateSuspended: Boolean; ParentSock: TSocket);
begin
  inherited Create(CreateSuspended);
  //FreeOnTerminate := True;
  Fserver := ParentSock;
end;

procedure TServerThread.Execute;
var
  ClientSocket: TSocket;
  Ra:    TSockaddr;
  RaLen: TSocklen;
  Buf:TByteArray;
  BufLen:Integer;
begin
  while true do begin
    RaLen  := SizeOf(Ra);
    ClientSocket := fpaccept(Fserver, @Ra, @RaLen);
    if ClientSocket<=0 then
      break;
    BufLen := SizeOf(TByteArray);
    BufLen := fprecv(ClientSocket, @Buf, BufLen, 0);
    if BufLen > 0 then
      fpsend(ClientSocket, @Buf, BufLen, 0);
    CloseSocket(ClientSocket);
    sleep(100);
  end;
end;

procedure TDaemon1.DataModuleStart(Sender: TCustomDaemon; var OK: Boolean);
var
  aConfig: TNetConfig;
  addr:    TSockAddr;
  addrlen: TSocklen;
begin
  try
    aConfig := GetConfig;
    Self.Logger.Active := False;
    Self.Logger.FileName := aConfig.LogPath;
    Self.Logger.Active:=True;

    FSvr := fpSocket(AF_INET, SOCK_STREAM, 0);
    if FSvr = SOCKET_ERROR then begin
      Self.LogMessage(DateTimeToStr(Now) + ': Create Socket Error !');
      OK := False;
      exit;
    end;
    addrlen := sizeof(addr);
    fillchar(addr, addrlen, 0);
    addr.sin_family := AF_INET;
    addr.sin_port   := htons(aConfig.Port);
    addr.sin_addr.s_addr := htonl(INADDR_ANY);
    if fpbind(FSvr, @addr, addrlen)<>0 then begin
      Self.LogMessage(DateTimeToStr(Now) + ': Create Server Error !');
      OK := False;
      Exit;
    end;
    if fplisten(FSvr, 5)<>0 then begin
      Self.LogMessage(DateTimeToStr(Now) + ': Create Server Listen Error !');
      OK := False;
      Exit;
    end;
    ServerThread := TServerThread.Create(false, FSvr);

    OK := True;
    Self.LogMessage(DateTimeToStr(Now) + ': filesrv start succeed !');
  except
    OK := False;
    Self.LogMessage(DateTimeToStr(Now) + ': filesrv start invalid !');
  end;
end;

procedure TDaemon1.DataModuleStop(Sender: TCustomDaemon; var OK: Boolean);
begin
  try
    if FSvr <> INVALID_Socket then
      closesocket(FSvr);
    OK:=True;
    Self.LogMessage(DateTimeToStr(Now) + ': filesrv stop succeed !');
  except
    OK:=False;
    Self.LogMessage(DateTimeToStr(Now) + ': filesrv stop invalid !');
  end;
end;

function TDaemon1.GetConfig: TNetConfig;
var
  iniFile: TIniFile;
begin
  if FileExistsUTF8('/etc/filesrv.conf') then begin
    iniFile := TIniFile.Create('/etc/filesrv.conf');
    try
      Result.IP := iniFile.ReadString('NetConfig', 'IP', '127.0.0.1');
      Result.LogPath := iniFile.ReadString('NetConfig', 'LogPath', '/tmp/filesrv.log');
      Result.Port := iniFile.ReadInteger('NetConfig', &#39ort', 12345);
    finally
      iniFile.Free;
    end;
  end else begin
    raise Exception.Create('not found config file: /etc/filesrv.conf !');
  end;
end;
{$R *.lfm}
initialization
  RegisterDaemon;
end.

渔夫

#!/bin/sh
binpath=/home/ccx/Documents/filesrv_socket/filesrv
test -f $binpath || exit 0
. /lib/lsb/init-functions        #asianux: /etc/init.d/functions

case "$1" in
start)
  log_begin_msg "Starting filesrv..."
  #$binpath -r &   
  if start-stop-daemon --start --background --quiet --oknodo --exec $binpath -- -r; then
    log_end_msg 0
  else
    log_end_msg 1
  fi
  #log_end_msg $?
  ;;
stop)
  log_begin_msg "Stopping filesrv..."
  #kill -9 $(ps -ef|grep filesrv|grep -v grep|awk '{print $2}')
  if start-stop-daemon --stop --quiet --oknodo --exec $binpath; then
    log_end_msg 0
  else
    log_end_msg 1
    fi
  #log_end_msg $?
  ;;
restart|force-reload)
  $0 stop
  sleep 1
  $0 start
  ;;
*)
  log_success_msg "Usage: $binpath {start|stop|restart|force-reload}"
  exit 1
esac

exit 0

渔夫

这个源码我挂在群共享中，大家有兴趣可以去下载
但要使程序运行起来，须要调整一下编译参数：
工程->工程选项->编译选项->其余的->自定义选项
在框里添加“-dUseCThreads”

以上代码借鉴了敬之和纯蓝犹豫网友的代码，多谢二位！

bugxiong

优秀文章，支持！n神马都是浮云！

渔夫

守护程序就是根据lazdeamon模块生成,
编译好的程序加入到windows服务中:
  mydaemon.exe -i
程序运行
  net start mydaemon
服务删除
  net stop mydaemon
  mydaemon.exe -u

fatspider

支持一下。不错。

猫工

如果守护程序退出了，挂掉了，怎么办？你想过没有？