Konsolenanwendung + STRG+C Abfangen

[redplug]

ich schreibe gerade eine kleine Server Anwendung und würde mein Socket gerne wieder Freigeben wen die Anwendung beendet wird

es ist eine konsolenanwendung. jedoch kann ich kein OnTerminate definieren.

Code: Alles auswählen

type
 
  { TServer }
 
  TServer = class(TCustomApplication)
  protected
    procedure DoRun; override;
  private
    Sock: TTCPBlockSocket;
  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    procedure WriteHelp; virtual;
  end;
 
{ TServer }
 
 
var
  Clients: Array of TClient;
 
procedure Echo(Str: String); overload;
var
  Time: TDateTime;
begin
  Time := Now;
  WriteLn('[' + FormatDateTime('dd.mm.yyyy tt.z', Time) + ']: ' + Str + #13);
end;
procedure Echo(Str: String; Id: Integer); overload;
var
  Time: TDateTime;
begin
  Time := Now;
  WriteLn('[' + FormatDateTime('dd.mm.yyyy tt.z', Time) + '] #' + IntToStr(Id) + ': ' + Str + #13);
end;
 
function AcceptClient(ClientSock: TSocket): Integer;
var
  ClientId: Integer;
begin
   ClientId := Length(Clients);
   setLength(Clients, ClientId + 1);
   Clients[ClientId] := TClient.Create(ClientSock);
   Clients[ClientId].Data.Id := ClientId;
   Result := ClientId;
end;
 
procedure TServer.DoRun;
var
  ErrorMsg: String;
  ClientSock: TSocket;
begin
  // quick check parameters
  ErrorMsg:=CheckOptions('h','help');
  if ErrorMsg<>'' then begin
    ShowException(Exception.Create(ErrorMsg));
    Terminate;
    Exit;
  end;
 
  // parse parameters
  if HasOption('h','help') then begin
    WriteHelp;
    Terminate;
    Exit;
  end;
  setLength(Clients, 0);
 
  Echo('Starting');
  Sock := TTCPBlockSocket.Create;
  with sock do
    begin
      CreateSocket;
      setLinger(true, 10000);
      Echo('Bind Socket');
      Bind('0.0.0.0', '1300');
      Listen;
      repeat
        if Terminated then break;
        if canRead(1000) then
          begin
            ClientSock := Accept;
            if lastError = 0 then
            begin
              Echo('NewClient', AcceptClient(ClientSock));
            end;
          end;
      until false;
    end;
  // stop program loop
  Terminate;
end;
 
constructor TServer.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
  StopOnException:=True;
end;
 
destructor TServer.Destroy;
begin
  inherited Destroy;
end;
 
procedure TServer.WriteHelp;
begin
  { add your help code here }
  writeln('Usage: ',ExeName,' -h');
end;
 
var
  Application: TServer;
 
{$IFDEF WINDOWS}{$R project1.rc}{$ENDIF}
 
begin
  Application:=TServer.Create(nil);
  Application.Title:='Server';
  Application.Run;
  Application.Free;
end.

An welcher stelle soll ich das Socket freigeben damit es auch noch nach einem Strg + c passiert?

[redplug]

Okey. Ich habe gerade gelesen das mit Strg+C die Exeption "EControlC" ausgelöst wird
Mal sehen wie ich diese Exeption jetzt handlen kann

[redplug]

Ok das sieht interresannt aus:

http://www.freepascal.org/docs-html/rtl ... ignal.html

[redplug]

Ok ich habs raus:


Beim start muss dem SIG event ein Handler zugewiesen werden.
Joar und dieser Handler kann halt dann das machen was man machen will.

aber es funktioniert glaube ich nur auf Linux. muss man testen

Code: Alles auswählen

program project1;    
 
uses BaseUnix;
 
procedure DoSig(SIG: cInt); cdecl;
begin
   case SIG of
     SIGINT:
     begin
       WriteLn('Receive SIGINT. Halt.');
       Halt(1);
     end;
   end;
end;
 
begin
  fpSignal(SIGINT, SignalHandler(@DoSig));
  ReadLn;
end.

[Hitman]

Unter Windows gehts per SetConsoleCtrlHandler.
Beides (Linux und Windows) hab ich beispielsweise -> hier <- implementiert.

[redplug]

Was ist mit Mac?

Ich glaube das mit SIG geht auf allen Unix Sythemen, nicht oder?

Edit:

Ja geht es:
http://developer.apple.com/mac/library/ ... nal.3.html

BTW gute Liste mit Signalen