Konsolenprogramm (mit ServerSocket) Keine Ahnung wie

[Real_Thunder]

Hallo zusammen,
Ich versuche gerade mein Serverprogramm (VCL Formularanwendung) in eine Konsolenanwendung umzuschreiben.

Bei der Programierung des Programms habe ich schon drauf geachtet das ich (bis auf ein TMemo und halt die TForm) auf
visuelle objekte verzichte...

Nun wollte ich mich dran machen, das Programm in eine Konsolenanwendung umzuschreiben...
Ich habe es bis jetzt geschafft, das sich ein Client zu dem Server verbinden kann...

TServersocket hab nen eigenen tread bekommen, doch reagiert auf nichts..
das hauptprogramm lasse ich dann in einer endlosschleife laufen.

Kennt jemand ein Tutorial, oder hat jemand ne idee woran es liegt ?

Ich habe von der Konsolenprogrammierung wenig ahnung....

Dies habe ich bis jetzt gemacht

Delphi-Quellcode:

program ConServ;

{$APPTYPE CONSOLE}

uses
  SysUtils, ScktComp, WinSock, Classes, StdCtrls,IdComponent, IdTCPConnection, IdTCPClient,
  IdHTTP,Controls,ExtCtrls;


type
  PMethodPointer = ^TMethodPointer;
  TMethodPointer = packed record
    pMethod: Pointer;
    pObject: TObject;
  end;


  THaupt=class(TThread)
  public
    procedure StartTH;
  end;


  TNetzFunc = class
    function getIPs: Tstrings;
    function GetExtIp:string;
    function CreateServerSock:String;
  end;

  TConfigFunc = class
    Procedure StartConfig;

  end;

  TServerThread = class(TThread)
    ServerSocket: TServerSocket;
    Port: Word;
    constructor Create;
    destructor Destroy;

    procedure OnServerAccept(Sender: TObject; Socket: TCustomWinSocket);
    procedure OnClientRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure OnClientConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure OnClientConnected(Sender: TObject; Socket: TCustomWinSocket);
{
    procedure OnClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
}
    procedure OnServerShutDown(SendText: String);

  end;


  TClient = record id, nick, buddies, ignore:string; socket:TCustomWinSocket;
  end;
  TServConfig = record Port, LifeTime:integer;
  end;


var
  clientda:boolean=false;
  Befehl:string;
  ServerThread:TServerThread;
  Haupt:THaupt;

  NetzFunc:TNetzFunc;
  ServConfig:TServConfig;
  ConfigFunc: TConfigFunc;
  Client: Array of TClient;
  CommonServerSocket: TServerSocket;




constructor TServerThread.Create;
begin
  inherited Create(True);
  ServerSocket:=TServerSocket.Create(nil);
end;

destructor TServerThread.Destroy;
begin
  ServerSocket.Destroy;
  inherited Destroy;
end;


procedure TServerThread.OnServerAccept(Sender: TObject; Socket: TCustomWinSocket);
begin
// Hallo

end;

procedure TServerThread.OnClientRead(Sender: TObject; Socket: TCustomWinSocket);
begin

socket.SendText('HUHU');
end;


procedure TServerThread.OnClientConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
beep;
clientda:=true;
writeln('Client hat verbunden');

Socket.SendText('Moin Moin');

//
end;

procedure TServerThread.OnClientConnected(Sender: TObject; Socket: TCustomWinSocket);
begin
beep;
writeln('Client hat verbunden');

Socket.SendText('Moin Moin');

//
end;




procedure TServerThread.OnServerShutDown(SendText: String);
begin
writeln('Verbindung wurde unterbrochen');
end;


function TNetzFunc.getIPs: Tstrings;
type
  TaPInAddr = array[0..10] of PInAddr;
  PaPInAddr = ^TaPInAddr;
var
  phe: PHostEnt;
  pptr: PaPInAddr;
  Buffer: array[0..63] of Char;
  I: Integer;
  GInitData: TWSAData;
begin
  WSAStartup($101, GInitData);
  Result := TstringList.Create;
  Result.Clear;
  GetHostName(Buffer, SizeOf(Buffer));
  phe := GetHostByName(buffer);
  if phe = nil then Exit;
  pPtr := PaPInAddr(phe^.h_addr_list);
  I    := 0;
  while pPtr^[I] <> nil do
  begin
    Result.Add(inet_ntoa(pptr^[I]^));
    Inc(I);
  end;
  WSACleanup;
end;

function TNetzFunc.GetExtIp:string;
var
  IdHTTP1:TidHTTP;
  Temp: string;
begin
  IdHTTP1:=TidHTTP.create;
  Temp := IdHTTP1.Get('http://checkip.dyndns.org');
  result := Copy(Temp, Pos(':', Temp) + 2, Pos('</bo', Temp) - Pos(':', Temp) - 2);
end;

function TNetzFunc.CreateServerSock:String;
begin
CommonServerSocket:=TServerSocket.create(nil);
CommonServerSocket.Port:= ServConfig.port;
end;



procedure TConfigFunc.StartConfig;
var
  a:integer;
begin
  ServerThread:=TServerThread.Create;
  ServConfig.Port:=7320;

  Writeln('Lade Konfiguration....');
  Writeln(' -Netzwerk Konfiguration:');
  for a :=0 to NetzFunc.getIPs.Count -1 do begin
    Writeln('   -Interne IP #'+inttostr(a+1)+': '+NetzFunc.getIPs[a]);
  end;
    Writeln('   -Aktive Ext.IP: '+NetzFunc.GetExtIp);
    Writeln(' -Versuche Socket zu Starten');
    Writeln('   -Eigestellter Port: '+IntToStr(ServConfig.Port));
      Write('   -Starte Socket... ');

    with ServerThread do begin
      ServerSocket.OnAccept:=ServerThread.OnServerAccept;
      ServerSocket.OnClientConnect:=ServerThread.OnClientConnect;

//      ServerSocket.OnClientDisconnect:=ServerThread.OnClientDisconnect;

      ServerSocket.OnClientRead:=ServerThread.OnClientRead;

end;


ServerThread.ServerSocket.Active:=False;
ServerThread.ServerSocket.Port:=ServConfig.Port;
ServerThread.Port:=ServConfig.Port;
try
ServerThread.ServerSocket.Active:=True;
except
ServerThread.ServerSocket.Active:=False;


Writeln(' Fehlgeschlagen');
end;

Writeln(' OK');

end;


procedure Ping(Self: TMethodPointer; Sender: TObject);
begin

//  writeln('Ping.... ');

end;




procedure THaupt.Startth;
begin

while befehl <> 'ende' do begin
write('Befehl:');
readln(Befehl);
end;
end;


begin



  Writeln('Messenger-Server V 0.05');
  Writeln('=======================');
  Writeln('');
  ConfigFunc.StartConfig;
  Writeln('');



Haupt:=THaupt.Create(true);
// Haupt.Execute;



while Befehl <> 'ende' do begin
// writeln('');
// write('Befehl:');

// Haupt.Execute;

if clientda=true then begin
clientda:=false;
writeln ('Client hat verbunden');
end;



end;


ServerThread.Destroy;


end.

Mfg Real Thunder

[Muetze1]

Wenn du in der Hauptschleife ständig im Kreis läufst und niemals Zeit abgibst, dann kommt dein Thread nie zum Zuge. Du musst auch Rechenzeit abgeben.

[Real_Thunder]

Hmm.. Habe mal in die Schleife ein Sleep(100) Reingesetzt..
Hilft aber Trotzdem Nichts

Dieses Habe ich noch hinzugefügt

Delphi-Quellcode:

while Befehl <> 'ende' do begin


i:=ServerThread.ServerSocket.Socket.ActiveConnections;

writeln(IntToStr(i));
sleep(100);

if i > 0 then begin
  ServerThread.ServerSocket.Socket.Connections[0].SendText('BlaBlaBla');
end;

writeln ('Client hat verbunden');
end;

Doch er Zeigt mir immer eine 0 an... Obwohl der testclient Verbunden anzeigt.

[Klaus01]

Zitat von Real_Thunder:

Hmm.. Habe mal in die Schleife ein Sleep(100) Reingesetzt..

Guten Morgen,

ein Sleep gibt keine Rechenzeit frei, es hält das Programm nur ein gewisse Zeit an. Suche hier in der CodeLib einmal nach delay und verwende das.

Grüße
Klaus

[Real_Thunder]

Habe mir diese Beispiele Angesehen, doch diese Beispiele benutzen alle ein
application.processmessages; Weches in Konsolenanwednungen aber nicht funktioniert.....

irgendwie stehe ih auf dem Schlauch.

[Klaus01]

Wenn Du in die uses noch die forms aufnimmst, dann klappt es auch mit application.processMessages

Grüße
Klaus

[Real_Thunder]

Vielen dank für die Hilfe, Endlich mal ne reaction vom server