请选择 进入手机版 | 继续访问电脑版

Lazarus中文社区

 找回密码
 立即注册

QQ登录

只需一步,快速开始

Lazarus IDE and 组件 下载地址版权申明
查看: 3162|回复: 6

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

[复制链接]

该用户从未签到

发表于 2012-4-23 19:03:44 | 显示全部楼层 |阅读模式
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.

评分

参与人数 1威望 +11 收起 理由
bugxiong + 11 优秀文章,支持!n神马都是浮云!

查看全部评分

回复

使用道具 举报

该用户从未签到

 楼主 发表于 2012-4-23 19:05:25 | 显示全部楼层

ubuntu下启动服务程序的shell

#!/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
回复 支持 反对

使用道具 举报

该用户从未签到

 楼主 发表于 2012-4-23 19:09:27 | 显示全部楼层
这个源码我挂在群共享中,大家有兴趣可以去下载
但要使程序运行起来,须要调整一下编译参数:
工程->工程选项->编译选项->其余的->自定义选项
在框里添加“-dUseCThreads”

以上代码借鉴了敬之和纯蓝犹豫网友的代码,多谢二位!
回复 支持 反对

使用道具 举报

该用户从未签到

发表于 2012-4-23 19:22:43 | 显示全部楼层
优秀文章,支持!n神马都是浮云!
回复 支持 反对

使用道具 举报

该用户从未签到

 楼主 发表于 2012-5-8 22:06:58 | 显示全部楼层

守护程序在windows下的使用办法

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

使用道具 举报

该用户从未签到

发表于 2012-5-26 12:59:26 | 显示全部楼层
支持一下。不错。
回复 支持 反对

使用道具 举报

该用户从未签到

发表于 2012-5-26 20:24:48 | 显示全部楼层
如果守护程序退出了,挂掉了,怎么办?你想过没有?
回复 支持 反对

使用道具 举报

QQ|手机版|小黑屋|Lazarus中国|Lazarus中文社区 ( 鄂ICP备16006501号-1

GMT+8, 2021-6-25 09:16 , Processed in 0.059855 second(s), 28 queries .

Powered by Discuz! F1.0 Build 20160930

© 2001-2021 Comsenz Inc. & Discuz! Fans

快速回复 返回顶部 返回列表