Пример построения простого Telnet сервера на Дельфи

Пример построения простого Telnet сервера на Дельфи
скачать (43.5 kb.)

Доступные файлы (1):

1.doc

44kb.

15.11.2011 20:20

скачать

содержание

1.doc

Простой Telnet сервер на Дельфи

Telnet |

18-02-2004 08:59

Здравствуйте.
Необходимо иметь свой TelNet сервер. Как я понимаю есть 2 решения:
1. Создание сервера "с нуля"
2. Програмирование каким либо образом готового сервера.
Рад буду получить любую информацию в области этих двух вариантов, так как сам столкнулся с такой задачей впервые.
Заранее, благодарен.

Ответы:

Уважаемые авторы вопросов! ^ Большая просьба сообщить о результатах решения проблемы на этой странице.
Иначе, следящие за обсуждением, возможно имеющие аналогичные проблемы, не получают ясного представления об их решении. А авторы ответов не получают обратной связи. Что можно расценивать, как проявление неуважения к отвечающим от автора вопроса.

23-02-2004 17:02 | Сообщение от автора вопроса

Проверил - все отлично... работает :)
Только немного надо пояснить:
1. Что за деректива OnlyOurSubnet
2. А также не совсем понятен код:
{$IFDEF OnlyOurSubnet}
AddrLen := SizeOf(ClientAddr);
Sock := Accept(OurSocket,@ClientAddr,@AddrLen);
{$ELSE}
Sock := Accept(OurSocket,nil,nil);
{$ENDIF}
if (Sock <> INVALID_SOCKET) then
begin
{$IFDEF OnlyOurSubnet}
// Вот здесь - что за сравнение?
if (ClientAddr.sin_addr.S_addr = $0100007F) or
((ClientAddr.sin_addr.S_addr and $00FFFFFF) = (OurAddr.sin_addr.S_addr and
$00FFFFFF)) then
TControlThread.Create(True).CreateSocket(Sock)
else begin
Shutdown(Sock,SD_BOTH);
CloseSocket(Sock);
end;
{$ELSE}
TSocketThread.Create(True).CreateSocket(Sock)
{$ENDIF}
end;

AmonRa
Просмотреть все ответы этого автора

19-02-2004 11:08

В Delphi 7 есть компонент TIdTelnetServer, можно попробовать использовать его, я сам не юзал.

Либо вот простенький примерчик:

Файл Listener.pas:
// Simple telnet server example
// (c) 2003, by Alexander Lushin

unit Listener;

interface

uses
Classes;

{$DEFINE OnlyOurSubnet}

type
TTerminalThread = class(TThread)
private
{ Private declarations }
protected
procedure Execute; override;
end;

function StartServices: boolean;
procedure StopServices;

implementation

uses Windows, WinSock, Sockets, SysUtils;

var
TerminalThread: TTerminalThread = nil;

function StartServices: boolean;
begin
Result := False;
InitWinsock;
TerminalThread := TTerminalThread.Create(False);
Result := Assigned(TerminalThread);
end;

procedure StopServices;
begin
if Assigned(TerminalThread) then
TerminalThread.Terminate;
TerminalThread := nil;
CloseWinsock;
end;

procedure TTerminalThread.Execute;
const
TmpBool: BOOL = True;
var
OurSocket: TSocket;
OurAddr: TSockAddr;
{$IFDEF OnlyOurSubnet}
ClientAddr: TSockAddr;
AddrLen: Integer;
{$ENDIF}
Sock: TSocket;
OurName: string[32];
OurInfo: PHostEnt;
begin
Priority := tpLower;
FreeOnTerminate := True;
if gethostname(@OurName[1],30) <> SOCKET_ERROR then
begin
OurInfo := gethostbyname(@OurName[1]);
if Assigned(OurInfo) then
begin
OurAddr.sin_family := AF_INET;
OurAddr.sin_port := htons(TerminalPort);
Move(OurInfo.H_Addr^^,OurAddr.sin_addr.S_addr,SizeOf(OurAddr.sin_addr.S_addr));
OurSocket := Socket(AF_INET,SOCK_STREAM,IPPROTO_TCP);
SetSockOpt(OurSocket,SOL_SOCKET,SO_REUSEADDR,@TmpBool,SizeOf(TmpBool));
if Bind(OurSocket,OurAddr,SizeOf(OurAddr)) <> SOCKET_ERROR then
while not Terminated do
begin
if Listen(OurSocket,MaxTerminalConn) <> SOCKET_ERROR then
begin
{$IFDEF OnlyOurSubnet}
AddrLen := SizeOf(ClientAddr);
Sock := Accept(OurSocket,@ClientAddr,@AddrLen);
{$ELSE}
Sock := Accept(OurSocket,nil,nil);
{$ENDIF}
if (Sock <> INVALID_SOCKET) then
begin
{$IFDEF OnlyOurSubnet}
if (ClientAddr.sin_addr.S_addr = $0100007F) or ((ClientAddr.sin_addr.S_addr and $00FFFFFF) = (OurAddr.sin_addr.S_addr and $00FFFFFF)) then
TControlThread.Create(True).CreateSocket(Sock)
else begin
Shutdown(Sock,SD_BOTH);
CloseSocket(Sock);
end;
{$ELSE}
TSocketThread.Create(True).CreateSocket(Sock)
{$ENDIF}
end;
end;
Sleep(5);
end;
end;
end;
end;

initialization

finalization
StopServices;

end.

Файл Sockets.pas:
// Simple telnet server example
// (c) 2003, by Alexander Lushin

unit Sockets;

interface

{$I-}

uses
Classes, Windows, WinSock;

type
TControlThread = class(TThread)
private
{ Private declarations }
SrcSocket: TSocket;
protected
procedure Execute; override;
public
procedure CreateSocket(Sct: TSocket);
end;

TmpFDSet = record
fd_count: u_int;
fd_array: array[0..0] of TSocket;
end;

TmpFDSet2 = record
fd_count: u_int;
fd_array: array[0..1] of TSocket;
end;

var
TerminalPort: integer = 23;
MaxTerminalConn: integer = 10;
TimeOut: dword = 60;

const
TV: TimeVal = (tv_sec: 0; tv_usec: 100);

procedure InitWinsock;
procedure CloseWinsock;

implementation

uses SysUtils, SyncObjs, Dialogs;

type
TCommand = (cmdUnknown,cmdSetMaxConn,cmdGetMaxConn,cmdSetAccel,cmdGetAccel,cmdSetTimeOut,cmdGetTimeOut,cmdHelp,cmdBye);

const
CmdStrs: array [cmdSetMaxConn..cmdBye] of string = ('SET MAXCONN','GET MAXCONN','SET ACCEL','GET ACCEL','SET TIMEOUT','GET TIMEOUT','HELP','BYE');
HelpStr: string = 'Commands:'#13#10+
'Set MaxConn <Max_Connection_Number> - Sets Max incoming connections number'#13#10+
'Get MaxConn - Shows max incoming connections number'#13#10+
'Set Accel - Turns on/off multipart transfers (Not implemented)'#13#10+
'Get Accel - Shows multipart transfers status (Not implemented)'#13#10+
'Set TimeOut <TimeOut> - Sets IO timeout (in seconds)'#13#10+
'Get TimeOut - Shows IO timeout'#13#10+
'Help - Shows this message'#13#10+
'Bye - Terminate control session'#13#10;

procedure TControlThread.Execute;
var
Buf,BufTmp: PChar;
i,j,l,Received,Total: integer;
A,Msg: string;
Cmd,Tmp: TCommand;
begin
GetMem(Buf,$10000);
try
Msg := 'Ready...'#13#10#13#10'>';
Send(SrcSocket,(@Msg[1])^,Length(Msg),0);

Cmd := cmdUnknown;
repeat
FillChar(Buf^,$10000,0);
BufTmp := Buf;
Total := 0;
Received := 0;
repeat
if Total > $FFF0 then
break;
Received := Recv(SrcSocket,BufTmp^,1,0);
if (Received = 0) or (Received = SOCKET_ERROR) or (BufTmp[0] = #10) then
break;
Inc(Total,Received);
Inc(BufTmp,Received);
until false;
if Received <> SOCKET_ERROR then
begin
A := UpperCase(StrPas(Buf));
Cmd := cmdUnknown;
if A <> '' then
for Tmp := cmdSetMaxConn to cmdBye do
begin
if Copy(A,1,Length(CmdStrs[Tmp])) = CmdStrs[Tmp] then
begin
Cmd := Tmp;
Delete(A,1,Length(CmdStrs[Tmp]));
break;
end;
end;
Msg := '';
case Cmd of
cmdGetMaxConn:
Msg := 'Max incoming connections = '+IntToStr(MaxConn);
cmdGetTimeOut:
Msg := 'IO timeout = '+IntToStr(TimeOut);
cmdSetMaxConn:
begin
i := 1;
l := Length(A)-2;
while (i <= l) and (not (A[i] in ['0'..'9'])) do inc(i);
j := i;
while (j <= l) and (A[j] in ['0'..'9']) do inc(j);
l := j-i;
try
MaxConn := StrToInt(Copy(A,i,l));
except
end;
Msg := 'Max incoming connections now set to '+IntToStr(MaxConn);
end;
cmdSetTimeout:
begin
i := 1;
l := Length(A)-2;
while (i <= l) and (not (A[i] in ['0'..'9'])) do inc(i);
j := i;
while (j <= l) and (A[j] in ['0'..'9']) do inc(j);
l := j-i;
try
TimeOut := StrToInt(Copy(A,i,l));
except
end;
Msg := 'IO timeout now set to '+IntToStr(TimeOut);
end;
cmdGetAccel,cmdSetAccel:
Msg := 'Not implemented';
cmdHelp:
Msg := HelpStr;
cmdBye:
Msg := 'Good Bye!';
else Msg := 'Unknown command!'
end;
if Msg <> '' then
begin
Msg := Msg+#13#10'>';
Send(SrcSocket,(@Msg[1])^,Length(Msg),0);
end;
end else break;
until Cmd = cmdBye;
finally
Shutdown(SrcSocket,SD_BOTH);
CloseSocket(SrcSocket);
FreeMem(Buf);
end;
end;

procedure TControlThread.CreateSocket(Sct: TSocket);
begin
SrcSocket := Sct;
FreeOnTerminate := True;
Priority := tpLower;
Resume;
end;

procedure InitWinsock;
var
WSAInfo: WSAData;
begin
WSAStartup(MAKEWORD(2,0),WSAInfo);
end;

procedure CloseWinsock;
begin
WSACleanup;
end;

initialization

finalization

end.

Может я где чего забыл, т.к. выдирал из проекта только то, что относится к вопросу.

Александр

Скачать файл (43.5 kb.)

Пример построения простого Telnet сервера на Дельфи - файл 1.doc

Доступные файлы (1):

1.doc