unit Socket_MISK;

interface
Uses Windows,WinSock, Forms, Classes, RussianCodeTables;

const
  INVALID_IP_ADDRESS= $ffffffff;  (* only invalid as a host ip, maybe OK for broadcast *)
Type
TCharset = (csNone,
            csDOS,
            csKOI,
            csWin1251);


procedure write_s(f_socket:TSocket; const s:string);

Procedure Close_Socket;
Function Init_Socket:Boolean;
Function Make_Socket:Boolean;
Function Lookup_HostName(const HostName:String):longint;
Function Find_POPHost(HostName:String):Boolean;
Function Connect_POPHost:Boolean;

Function Response_Host(CommandOnly:Boolean; Dest:TStrings; Charset:TCharset):Integer;

Function Read_Socket:Boolean;
Function Read_BuffLine(var PosInBuff:Integer):String;

Var
Buff:Array[0..1023] Of Char;
RecvByte:Integer;
hSocket:TSocket;
SockAddrIn:TSockAddrIn;
implementation

Procedure Close_Socket;
Begin {CloseSocket}
If NOT (hSocket = INVALID_SOCKET) Then
closesocket(hSocket);
WSACleanup;
End;  {CloseSocket}


Function Init_Socket:Boolean;
Var
wVersionRequested:Word;
WSAData:TWSAData;
Begin {Init_Socket}
Result:=False;
Close_Socket;
wVersionRequested:=MakeWord(1,1); //инициализируем сокет Windows
FillChar(WSAData,SizeOf(WSAData),#0);//обнулим все значения WSAData
If Not WSAStartup(wVersionRequested,WSAData)=0 Then //стартуем
Begin {If Not = 0}
//неудача при старте
Close_Socket; //уничтожим сокет
Exit;
End; {If Not = 0}
Result:=True;
End;{Init_Socket}

Function Make_Socket:Boolean;
Begin {Make_Socket}
Result:=False;
hSocket:=socket(PF_INET,SOCK_STREAM,IPPROTO_IP);
If hSocket = INVALID_SOCKET Then
Begin
Close_Socket;
Exit;
End;
Result:=True;
End;  {Make_Socket}

//эта функция взята из кода компонента TCPIP
Function Lookup_HostName(const HostName:String):longint;
Var
RemoteHost : PHostEnt;  (* no, don't free it! *)
ip_address: longint;
s: string;
Begin {lookup_hostname}
ip_address:=INVALID_IP_ADDRESS;
Try
If hostname='' Then
Begin
Result:=ip_address;
Exit;
End
Else
Begin
s:=hostname+#0;
ip_address:=Inet_Addr(PChar(hostname));  (* попробуем в начале IP-адрес xxx.xxx.xxx.xxх*)
If ip_address=SOCKET_ERROR Then //IP-адрес дан в виде domain-имени
Begin
RemoteHost:=GetHostByName(PChar(hostname));//получим перевод domain-имени в IP-адрес
If (RemoteHost=NIL) or (RemoteHost^.h_length<=0) Then
Begin
Result:=ip_address;
EXIT;  (* POP3-сервер не найден *)
End
Else
ip_address:=longint(pointer(RemoteHost^.h_addr_list^)^);
(* use the first address given *)
End;
End;
Except
ip_address:=INVALID_IP_ADDRESS;
End;
Result:=ip_address;
End; {lookup_hostname}



Function Find_POPHost(HostName:String):Boolean;
Begin {Find_POPHost}
Result:=False;
SockAddrIn.sin_addr.S_addr:=Lookup_HostName(HostName);
If SockAddrIn.sin_addr.S_addr = INVALID_IP_ADDRESS Then
Begin
Close_Socket;
Exit;
End;
SockAddrIn.sin_port:=htons(110); //порт для POP3
SockAddrIn.sin_family:=PF_INET;
Result:=True;
End;  {Find_POPHost}

Function Connect_POPHost:Boolean;
Begin {Connect_POPHost}
Result:=False;
If connect(hSocket,SockAddrIn,SizeOf(SockAddrIn))=SOCKET_ERROR Then
Begin
Close_Socket;
Exit;
End;
Result:=True;
End;  {Connect_POPHost}

Function Response_Host(CommandOnly:Boolean; Dest:TStrings; Charset:TCharset):Integer;
Var
S:String;
PosInBuff:Integer;
Begin {Response_Host}
Result:=0;
If Read_Socket Then
Begin
//читаем первую строку
PosInBuff:=0;
S:=Read_BuffLine(PosInBuff);
If Not(Pos('+OK',S)=1) Then
Begin
Dest.Add(S);
Result:=-1;
Exit;
End;
Dest.Add(S);
If CommandOnly Then Exit;
Repeat
Application.ProcessMessages;

S:=Read_BuffLine(PosInBuff);

Case Charset Of
csDOS:S:=DOSToWin(S);
csKOI:S:=KOIToWin(S);
End;

Dest.Add(S);
Inc(Result);
If PosInBuff>RecvByte Then
Begin
Read_Socket;
PosInBuff:=0;
End;
Until S='.';
End;
End;  {Response_Host}





Function Read_Socket:Boolean;
Begin {Read_Socket}
FillChar(Buff,SizeOf(Buff),#0);
RecvByte:=recv(hSocket,Buff,SizeOf(Buff),0);
Result:=Not(RecvByte = SOCKET_ERROR); //проверка на обрыв сокета
End;  {Read_Socket}

Function Read_BuffLine(var PosInBuff:Integer):String;
Begin {Read_Line}
Result:='';
While Not(Buff[PosInBuff]=#10) Do
Begin
If Not(Buff[PosInBuff]=#13) Then
Result:=Result+Buff[PosInBuff];
Inc(PosInBuff);
End;
Inc(PosInBuff);
End;  {Read_Line}


procedure write_buf(f_socket:TSocket; const buf; size:integer);
begin
  if Send(F_Socket,pointer(@buf)^,size,0)=SOCKET_ERROR then
     EXIT  (* Error writing *)
end;


procedure write_s(f_socket:TSocket; const s:string);
begin
  write_buf(f_socket,pchar(s)^,length(s));
end;







end.
