unit1.pas.bak

一个简单的execl(linux)下的服务器代码

unit Unit1;

interface

uses
  SysUtils, Types, Classes, Variants, QTypes, QGraphics, QControls, QForms,
  QDialogs, QStdCtrls,LibC, QExtCtrls, IdBaseComponent, IdComponent,
  IdTCPServer;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Timer1: TTimer;
    IdTCPServer1: TIdTCPServer;
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.xfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  chilid : pid_t;
begin
  chilid := fork();
  if chilid <> -1 then
  begin
    {
    if execl(pchar('/home/oracle/programming/delphi/LineUserCheck/Line2UserCheck'),
           pchar('Line2UserCheck'),#0) = -1 then
    begin
      ShowMessage('error');
    end else
      ShowMessage('ok');
      }
    LibC.System(pchar('/home/oracle/programming/delphi/LineUserCheck/Line2UserCheck'));
    //LibC.system(pchar('/home/oracle/programming/delphi/ServerMonitor/ServerMon'));
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  chilid : pid_t;
begin
  label1.Caption := IntToStr(StrToIntDef(label1.Caption,0)+1);
  if StrToIntDef(label1.Caption,0) > 10 then
  begin
    chilid := fork();
    if chilid <> -1 then
    execl(pchar('/home/oracle/programming/delphi/execl/Project1'),
          pchar('Project1'),#0);
  end;

  if StrToIntDef(label1.Caption,0) > 5 then
  begin
    try
      IdTCPServer1.Active := True;
    except
      Close();
    end;
  end;
end;

end.