Творец
Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант
Репутация: 4
Всего: 329
|
| Код |
unit MainUnit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, winsock, StdCtrls;
type
TTCPClientForm = class(TForm)
btRecvMessages: TButton;
edServer: TEdit;
Label1: TLabel;
mmLog: TMemo;
Label2: TLabel;
Label3: TLabel;
edPort: TEdit;
procedure btRecvMessagesClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
TCPClientForm: TTCPClientForm;
implementation
{$R *.dfm}
procedure TestWinSockError(S:String);
var
iErr:Integer;
sFullErr:String;
begin
sFullErr:='Неизвестная ошибка';
iErr:=WSAGetLastError();
case iErr of
WSANOTINITIALISED: sFullErr:='Нужно сначала вызвать функцию WSASturtup, а потом создавать сокет';
WSAENETDOWN: sFullErr:='Cвязь нарушена, возможные причины - отошёл кабель или отключились от Интернета';
WSAEADDRINUSE: sFullErr:='Указанный адрес уже используется';
WSAEFAULT: sFullErr:='Параметры name и namelen не соответствуют выбранной адресации. Параметр namelen может быть меньше необходимого значения, а name содержать некорректные данные';
WSAEINPROGRESS: sFullErr:='Выполняется операция в блокирующем режиме. Вы уже запустили на выполнение какую-то функцию и нужно дождаться завершения её работы';
WSAEINVAL: sFullErr:='Сокет уже связан с адресом';
WSAENOBUFS: sFullErr:='Недостаточно буферов, слишком много соединений';
WSAENOTSOCK: sFullErr:='Неверный дескриптор сокета';
WSAEISCONN: sFullErr:='Сокет уже подключён';
WSAEMFILE: sFullErr:='Нет больше доступных дескрипторов';
end;
MessageBox(0, PChar('Ошибка в функции '+S+' - '+sFullErr), 'Ошибка', 0);
end;
function TestFuncError(iErr:Integer; FuncName:String):Boolean;
begin
Result:=false;
if iErr = SOCKET_ERROR then
begin
TestWinSockError(FuncName);
Result:=true;
end;
end;
function LookupName(name:String): TInAddr;
var
HostEnt: PHostEnt;
InAddr: TInAddr;
begin
if name[4]='.' then
InAddr.s_addr := inet_addr(PChar(name))
else
begin
HostEnt := gethostbyname(PChar(name));
FillChar(InAddr, SizeOf(InAddr), 0);
if HostEnt <> nil then
begin
with InAddr, HostEnt^ do
begin
S_un_b.s_b1 := h_addr^[0];
S_un_b.s_b2 := h_addr^[1];
S_un_b.s_b3 := h_addr^[2];
S_un_b.s_b4 := h_addr^[3];
end;
end
end;
Result := InAddr;
end;
function GetLocalHost: string;
var
sh : array [0..255] of char;
begin
if gethostname(sh, 255)=0 then
Result := StrPas(sh)
else
Result := '';
end;
procedure SendStr(s:TSocket; str:String);
var
sRecvBuff : array [0..255] of char;
TempStr : AnsiString;
begin
TempStr:=str+#13+#10;
CopyMemory(@sRecvBuff, PChar(TempStr), Length(TempStr));
TestFuncError(send(s, sRecvBuff, Length(TempStr), 0), 'Send Attachment');
TCPClientForm.mmLog.Lines.Add('>'+Copy(TempStr, 1, Pos(#13, TempStr)));
end;
procedure GetStr(s:TSocket);
var
sRecvBuff : array [0..5000] of char;
TempStr : AnsiString;
begin
TestFuncError(recv(s, sRecvBuff, SizeOf(sRecvBuff), 0), 'Ошибка выхода');
TempStr:=sRecvBuff;
while Pos(#13, TempStr)>0 do
begin
TCPClientForm.mmLog.Lines.Add('<'+Copy(TempStr, 1, Pos(#13, TempStr)));
Delete(TempStr, 1, Pos(#13, TempStr)+1);
end;
Application.ProcessMessages;
end;
procedure TTCPClientForm.btRecvMessagesClick(Sender: TObject);
var
wData : WSADATA;
sServerListen: TSOCKET;
server_addr : sockaddr_in;
begin
mmLog.Clear;
// Загрузка WinSock
if WSAStartup(MAKEWORD(1,1), wData) <> 0 then
begin
MessageBox(0, 'Не могу загрузить WinSock', 'Ошибка', 0);
exit;
end;
// Создание сокета
sServerListen := socket(PF_INET, SOCK_STREAM, IPPROTO_IP);
if sServerListen = INVALID_SOCKET then
begin
MessageBox(0, 'Ошибка создания сокета', 'Ошибка', 0);
exit;
end;
// Запонение структуры адреса
server_addr.sin_addr.s_addr := htonl(INADDR_ANY);
server_addr.sin_family := AF_INET;
server_addr.sin_port := htons(StrToInt(edPort.Text));
server_addr.sin_addr := LookupName(edServer.Text);
if (connect(sServerListen, server_addr, sizeof(server_addr)) = SOCKET_ERROR) then
begin
TestWinSockError('Connect');
exit;
end;
GetStr(sServerListen);
SendStr(sServerListen, 'user smirnandr');
GetStr(sServerListen);
SendStr(sServerListen, 'pass dfgfdggtf');
GetStr(sServerListen);
SendStr(sServerListen, 'list');
Sleep(1000);
GetStr(sServerListen);
SendStr(sServerListen, 'retr 1');
Sleep(1000);
GetStr(sServerListen);
SendStr(sServerListen, 'dele 1');
GetStr(sServerListen);
SendStr(sServerListen, 'quit');
CloseSocket(sServerListen);
end;
end.
|
|
Получение почты через WSA 
Загрузка ...
Дата 24.5.2005, 08:57 (
