Idtcpserver + Ssl (indy 10)

Тема в разделе "Delphi - Сети", создана пользователем slavon-x86, 24 апр 2008.

  1. slavon-x86

    slavon-x86 Well-Known Member

    Регистрация:
    18 дек 2005
    Сообщения:
    216
    Симпатии:
    0
    Пишу в браузере http://localhost/, а сервер выдаёт ошибку "Error accepting connection with SSL"
    Сделал всё как в примере Indy, но не работает...

    Вот код сервера
    Код (Text):
    unit uServer;

    interface

    uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs, ComCtrls, Menus, ExtCtrls, IdBaseComponent, IdComponent, IdTCPServer,
    IdCustomHTTPServer,IdStream,idStreamVCL, IdHTTPServer, Buttons, IdContext, StdCtrls,
    IdServerIOHandler, IdSSL, IdSSLOpenSSL;

    const
    maxConnections = 4;
    clOn = clLime;
    clOff = clGreen;

    type
    AShape = array of TShape;

    type
    TForm1 = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    Panel1: TPanel;
    Panel2: TPanel;
    pServerActive: TPanel;
    Panel4: TPanel;
    TabSheet3: TTabSheet;
    Panel3: TPanel;
    bServerStart: TSpeedButton;
    bServerStop: TSpeedButton;
    Memo1: TMemo;
    IdTCPServer1: TIdTCPServer;
    Memo2: TMemo;
    Memo3: TMemo;
    IdServerIOHandlerSSLOpenSSL: TIdServerIOHandlerSSLOpenSSL;
    Timer1: TTimer;
    ledListening: TShape;
    procedure ledListeningContextPopup(Sender: TObject; MousePos: TPoint;
    var Handled: Boolean);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure Timer1Timer(Sender: TObject);
    procedure IdServerIOHandlerSSLOpenSSLGetPassword(var Password: string);
    procedure IdTCPServer1Execute(AContext: TIdContext);
    procedure IdTCPServer1Disconnect(AContext: TIdContext);
    procedure IdTCPServer1Connect(AContext: TIdContext);
    procedure bServerStopClick(Sender: TObject);
    procedure bServerStartClick(Sender: TObject);
    procedure OnTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    private
    { Private declarations }
    ledConnected: AShape;
    public
    { Public declarations }
    end;

    type
    THTTPInfoSpec = record
    Active: Boolean;
    end;

    THTTPInfo = record
    Spec: THTTPInfoSpec;
    Server: String[255];
    end;


    var
    Form1: TForm1;
    Timer: TTimer;
    HTTPInfo: THTTPInfo;
    idTCPserver2: TIdContext;

    implementation

    uses uServer2;

    {$R *.dfm}


    {Процедура таймера "OnTimer"}
    procedure TForm1.OnTimer(Sender: TObject);
    begin
    Timer.Enabled := False;


    Timer.Enabled := True;
    end;

    { Создание формы }
    procedure TForm1.FormCreate(Sender: TObject);
    var
    i, x: integer;
    appDir: string;
    begin
    left:= 580;
    top:= 80;

    IdTCPServer1.MaxConnections:= maxConnections;

    { IMPORTANT! You must specify the certificate, key, and root cert files! }
    appDir:= extractFilePath(application.exename);
    IdServerIOHandlerSSLOpenSSL.SSLOptions.KeyFile:= appDir + 'sample.key';
    IdServerIOHandlerSSLOpenSSL.SSLOptions.CertFile:= appDir + 'sample.crt';
    IdServerIOHandlerSSLOpenSSL.SSLOptions.RootCertFile:= appDir + 'sampleRoot.pem';

    setLength(ledConnected,maxConnections);

    x:= 225;
    for i:= 0 to (maxConnections - 1) do begin
    ledConnected[i]:= TShape.create(panel1);
    with ledConnected[i] do begin
    parent:= panel1;
    height:= 8;
    width:= 20;
    top:= 15;
    left:= x; inc(x,25);
    brush.color:= clOff;
    end; { do with ledConnected[i] }
    end; { for i:= 0 to (maxConnections - 1) }

    timer1.enabled:= true;

    end;


    { Старт }
    procedure TForm1.bServerStartClick(Sender: TObject);
    begin
    idTCPserver1.Active := True;
    end;

    { Стоп }
    procedure TForm1.bServerStopClick(Sender: TObject);
    begin
    //
    end;

    procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
    begin
    { THESE TWO LINES ARE CRITICAL TO MAKING THE IdTCPSERVER WORK WITH SSL! }
    if (AContext.Connection.IOHandler is TIdSSLIOHandlerSocketBase) then
    TIdSSLIOHandlerSocketBase(AContext.Connection.IOHandler).PassThrough:= False;

    Memo1.Lines.Add('connect...');
    end;

    procedure TForm1.IdTCPServer1Disconnect(AContext: TIdContext);
    begin
    Memo1.Lines.Add('disconnect...');
    end;

    procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
    var
    List: TList;
    s, s2, s3, s4, r: AnsiString;
    i: integer;
    c: char;
    TempStream: TFileStream;
    TempStringList: TIdStreamVCL;
    Stream: TIdStream;

    begin
    randomize;
    r := IntToStr(random(100));



    try
    List := IdTCPServer1.Contexts.LockList;
    Memo1.Lines.Add('execute...begin...['+IntToStr(List.Count)+'] - '+r);
    IdTCPServer1.Contexts.UnlockList;
    except
    end;

    Memo3.Clear;

    repeat
    c := AContext.Connection.Socket.ReadChar;
    i := AContext.Connection.Socket.InputBuffer.Size;

    s2 := s2 + c;
    until i = 0;

    Memo1.Lines.Add(s2);

    Memo3.Clear;
    Memo3.Lines.Add('<p>123<p>');

    Memo2.Clear;
    Memo2.Lines.Add('HTTP/1.1 200 OK');
    Memo2.Lines.Add('Server: Apache/2.2.3 (Debian)');
    Memo2.Lines.Add('Keep-Alive: timeout=15, max=100');
    Memo2.Lines.Add('Connection: Keep-Alive');
    Memo2.Lines.Add('Content-Type: text/html; charset=UTF-8');
    Memo2.Lines.Add('Content-Length: '+IntToStr(Length(Memo3.Text)));


    s := Memo2.Text +
    chr(10) +
    Memo3.Text;

    AContext.Connection.Socket.WriteLn(s);
    AContext.Connection.Disconnect;



    Memo1.Lines.Add('execute...end...');

    end;

    procedure TForm1.IdServerIOHandlerSSLOpenSSLGetPassword(var Password: string);
    begin
    password:= 'aaaa';
    end;

    procedure TForm1.Timer1Timer(Sender: TObject);
    begin
    { This approach (with the timer) is used to ensure that *everything* has been fully
    created and the application is running before we start the server up. }

    timer1.enabled:= false;
    IdTCPServer1.Active:= true;
    ledListening.Brush.color:= clOn;

    end;

    procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    begin
    idTcpServer1.Active:= false;
    ledListening.Brush.Color:= clOff;
    application.processMessages;
    canClose:= true;
    end;

    procedure TForm1.ledListeningContextPopup(Sender: TObject; MousePos: TPoint;
    var Handled: Boolean);
    begin

    end;

    end.
     
  2. slavon-x86

    slavon-x86 Well-Known Member

    Регистрация:
    18 дек 2005
    Сообщения:
    216
    Симпатии:
    0
    HTTPS делает запрос на 443 порт, поэтому и не работало, а у меня 80-й был открыт !
     
  3. slavon-x86

    slavon-x86 Well-Known Member

    Регистрация:
    18 дек 2005
    Сообщения:
    216
    Симпатии:
    0
    В эксплорере заработало, а в опере выдаёт всё ту же ошибку !
    Может это быть из-за того, что сертификат просроченный ?
     
  4. slavon-x86

    slavon-x86 Well-Known Member

    Регистрация:
    18 дек 2005
    Сообщения:
    216
    Симпатии:
    0
    Поставил SSL v3 и заработало.
     
Загрузка...
Похожие Темы - Idtcpserver Ssl (indy
  1. Shouldercannon
    Ответов:
    0
    Просмотров:
    627
  2. Shouldercannon
    Ответов:
    0
    Просмотров:
    494
  3. slavon-x86
    Ответов:
    12
    Просмотров:
    10.900
  4. erdi
    Ответов:
    1
    Просмотров:
    121
  5. ToxaRat
    Ответов:
    9
    Просмотров:
    808

Поделиться этой страницей