Einzelnen Beitrag anzeigen

Real_Thunder

Registriert seit: 25. Apr 2006
197 Beiträge
 
#1

Konsolenprogramm (mit ServerSocket) Keine Ahnung wie

  Alt 11. Apr 2007, 15:16
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 <> 'endedo 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 <> 'endedo 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
  Mit Zitat antworten Zitat