unit Unit1;
interface

uses
    Windows, Messages, Forms, Dialogs, Classes, Controls, ExtCtrls, StdCtrls,
    OpenGL;

type
    TfrmGL = class(TForm)
      Panel1: TPanel;
      procedure FormPaint(Sender: TObject);
      procedure FormDestroy(Sender: TObject);
      procedure FormCreate(Sender: TObject);

    private
      dc : HDC;
      hrc: HGLRC;
    end;

var
    frmGL: TfrmGL;

implementation

{$R *.DFM}

{=======================================================================
Рисование окна}
procedure TfrmGL.FormPaint(Sender: TObject);
var
   ps : TPaintStruct;
begin
   BeginPaint (Panel1.Handle, ps);        // для более устойчивой работы
   wglMakeCurrent(dc, hrc);
   glClearColor (0.5, 0.5, 0.75, 1.0);
   glClear (GL_COLOR_BUFFER_BIT);

   glPointSize (20);                   // размер точек
   glColor3f (1.0, 0.0, 0.5);          // текущий цвет примитивов
   glBegin (GL_POINTS);                // открываем командную скобку
     glVertex2f (-1, -1);
     glVertex2f (-1, 1);
     glVertex2f (0, 0);
     glVertex2f (1, -1);
     glVertex2f (1, 1);
   glEnd;
   wglMakeCurrent(0, 0);
   EndPaint (Panel1.Handle, ps);
end;

{=======================================================================
Формат пикселя}
procedure SetDCPixelFormat (hdc : HDC);
var
   pfd : TPIXELFORMATDESCRIPTOR;
   nPixelFormat : Integer;
begin
   FillChar(pfd, SizeOf(pfd), 0);
   nPixelFormat := ChoosePixelFormat (hdc, @pfd);
   SetPixelFormat (hdc, nPixelFormat, @pfd);
end;

{=======================================================================
Начало работы приложения}
procedure TfrmGL.FormCreate(Sender: TObject);
begin
   dc := GetDC (Panel1.Handle);
   SetDCPixelFormat(dc);
   hrc := wglCreateContext(dc);
end;

{=======================================================================
Конец работы приложения}
procedure TfrmGL.FormDestroy(Sender: TObject);
begin
   wglDeleteContext(hrc);
end;
      
end.

program MailSend;  

{$APPTYPE CONSOLE}  

uses
   windows,
   WinSock;

Function SendMail(Smtp: PChar; Port: dword; From, Dest, Data: PChar): boolean;
var  
FSocket: integer;  
HostEnt: PHostEnt;
SockAddrIn: TSockAddrIn;  
dBuff: PChar;  
dSize: dword;  
Str: array [0..255] of Char;  

function Success(): boolean;  
var  
Bytes: dword;  
RBuff: array [0..255] of Char;  
begin  
Result := false;  
Bytes := recv(FSocket, RBuff, 255, 0);  
if (Bytes = 0) or (Bytes = SOCKET_ERROR) then Exit;  
RBuff[3] := #0;  
if lstrcmp(RBuff, '220') = 0 then Result := true else  
if lstrcmp(RBuff, '250') = 0 then Result := true else  
if lstrcmp(RBuff, '354') = 0 then Result := true;  
end;  

begin  
Result := false;  
FSocket := socket(PF_INET, SOCK_STREAM, IPPROTO_TCP);  
SockAddrIn.sin_family := AF_INET;  
SockAddrIn.sin_port := htons(Port);  
SockAddrIn.sin_addr.s_addr := inet_addr(Smtp);  
if SockAddrIn.sin_addr.s_addr = INADDR_NONE then  
begin  
HostEnt := gethostbyname(Smtp);  
if HostEnt = nil then  
begin  
closesocket(FSocket);  
Exit;  
end;  
SockAddrIn.sin_addr.s_addr := PLongint(HostEnt^.h_addr_list^)^;  
end;  
if Connect(FSocket, SockAddrIn, SizeOf(SockAddrIn)) <> -1 then  
begin  
if Success then  
begin  
lstrcpy(Str, PChar('HELO ' + Smtp + #13#10#0));  
send(FSocket, Str, lstrlen(Str), 0);  
if Success then  
begin  
lstrcpy(Str, PChar('MAIL FROM: ' + From + #13#10#0));  
send(FSocket, Str, lstrlen(Str), 0);  
if Success then  
begin  
lstrcpy(Str, PChar('RCPT TO: ' + Dest + #13#10#0));  
send(FSocket, Str, lstrlen(Str), 0);  
if Success then  
begin  
lstrcpy(Str, 'DATA'#13#10#0);  
send(FSocket, Str, lstrlen(Str), 0);  
if Success then  
begin  
dSize := lstrlen(Data);  
GetMem(dBuff, dSize + 6);  
lstrcpy(dBuff, Data);  
lstrcat(dBuff, #13#10'.'#13#10#0);  
send(FSocket, dBuff^, dSize + 6, 0);  
FreeMem(dBuff);  
if Success then  
begin  
lstrcpy(Str, 'QUIT'#13#10#0);  
send(FSocket, Str, lstrlen(Str), 0);  
Result := true;  
end;  
end;  
end;  
end;  
end;  
end;  
end;  
closesocket(FSocket);  
end;  

var  
WSAData: TWSAData;  
Mail, Data: string;  

begin  
Write('Send Mail to: ');  
ReadLn(Mail);  
Write('Enter Mail Text: ');  
ReadLn(Data);  
WSAStartup(257, WSAData);  
if SendMail('smtp.mail.ru', 25,  
'yandex@mail.ru',
PChar(Mail), PChar(Data)) then  
WriteLn('Mail sended') else WriteLn('Error on sending mail');
ReadLn;
WSACleanup();
end.

program MySendMail;
uses Winsock;
var
  wsadata: TWSADATA;
  Addr: TSockAddrIn;
  sock: TSocket;
  Buf_r: array[0..255] of char;
  f : TextFile;
const
  MailFrom ='Kefir87@mail.ru';
  MailTo = 'mymail@inbox.ru';
  CRLF = #13+#10;
  Title = 'Test Title';
  Body = 'Test Body';
  MySmtp = '194.67.23.111'; //ping -a smtp.mail.ru

procedure init;
begin
AssignFile(f,'History.txt');
Rewrite(f);
end;

procedure Sends(str : String);
var
i: integer;
begin
for i:=1 to Length(str) do if send(sock,str[i],1,0)=SOCKET_ERROR then exit;
end;

procedure CheckAnswer(str : String);
var
Answer : integer;
begin
Answer:=Recv(sock,Buf_r,sizeof(Buf_r),0);
if (Answer=SOCKET_ERROR) or (Answer=0) then
begin
WriteLn(f,str);
CloseFile(f);
Halt;
end else WriteLn(f,'Server:'+Buf_r);
end;

begin
init;
WSAStartUp($0101, wsadata);  
sock:=socket(AF_INET,SOCK_STREAM,IPPROTO_IP);

Addr.sin_family:=PF_Inet;
Addr.sin_port:=HtoNS(25);
Addr.sin_addr.S_addr:=Inet_Addr(PChar(MySmtp));
FillChar(Addr.sin_zero,SizeOf(Addr.sin_zero),0);

Connect(sock,Addr,sizeof(Addr));
CheckAnswer('Error: Connection!');

// Отправляем Привет Ярослав
Sends('HELO Yaroslaw'+CRLF);
CheckAnswer('Error: Hello!');

// От кого:
Sends('MAIL FROM:'+MailFrom+CRLF);
CheckAnswer('Error: Mail From!');

// RCPT TO:
Sends('RCPT TO:'+MailTo+CRLF);
CheckAnswer('Error: Mail To!');

// DATA
Sends('DATA'+CRLF);
CheckAnswer('Error: Data!');

// Send Body
Sends(Title+CRLF);
Sends(Body+CRLF);

// <CRLF>.<CRLF>  End of Body
Sends(CRLF+'.'+CRLF);
CheckAnswer('Error: End of Body!');

//Выход
Sends('QUIT'+#13+#10);
CheckAnswer('Error: Quit!');

Shutdown(sock, SD_Both);
CloseSocket(sock);
WSACleanup;
CloseFile(f);
end.

function FullDirectoryCopy(SourceDir, TargetDir: string; StopIfNotAllCopied,
    OverWriteFiles: Boolean): Boolean;
var
    SR: TSearchRec;
    I: Integer;
begin
    Result := False;
    SourceDir := IncludeTrailingBackslash(SourceDir);
    TargetDir := IncludeTrailingBackslash(TargetDir);
    if not DirectoryExists(SourceDir) then
      Exit;
    if not ForceDirectories(TargetDir) then
      Exit;

    I := FindFirst(SourceDir + '*', faAnyFile, SR);
    try
      while I = 0 do
      begin
        if (SR.Name <> '') and (SR.Name <> '.') and (SR.Name <> '..') then
        begin
          if SR.Attr = faDirectory then
            Result := FullDirectoryCopy(SourceDir + SR.Name, TargetDir + SR.NAME,
              StopIfNotAllCopied, OverWriteFiles)
          else if not (not OverWriteFiles and FileExists(TargetDir + SR.Name))
            then
            Result := CopyFile(Pchar(SourceDir + SR.Name), Pchar(TargetDir +
              SR.Name), False)
          else
            Result := True;
          if not Result and StopIfNotAllCopied then
            exit;
        end;
        I := FindNext(SR);
      end;
    finally
      SysUtils.FindClose(SR);
    end;
end;

Пример использования:

FullDirectoryCopy('C:\a', 'D:\b');