webserv1.pas

著名的SecureBlackBox控件完整源码

unit WebServ1;

interface

// remember to install one of additional packages,
// located in <SecureBlackbox>\Classes\ICS,
// as described in SecureBlackbox readme file

uses
  Windows,
  Messages,
  SysUtils,
  Classes,
  Graphics,
  Controls,
  Forms,
  Dialogs,
  IniFiles,
  StdCtrls,
  ExtCtrls,
  WSocket,
  WSocketS,
  HttpSrv,
  SBUtils,
  SBX509,
  SBCustomCertStorage,
  SBICSHttpsServer;

const
  CopyRight: string = 'WebServ (c) 1999 F. Piette V1.00 BETA ';

type
  { This component is used for client connection instead of default one.    }
  { This enables to add any data we need to handle our application.         }
  { As this data is located in client component, each connected client has  }
  { his own private data.                                                   }
  TMyHttpConnection = class(TElHttpsConnection)
  protected
    FPostedDataBuffer: PChar; { Will hold dynamically allocated buffer }
    FDataLen: Integer; { Keep track of received byte count.     }
  public
    destructor Destroy; override;
  end;

  { This is the main form for our application. Any data here is global for  }
  { all clients. Put provate data in TMyHttpConnection class (see above).   }
  TAppBaseForm = class(TForm)
    ToolsPanel: TPanel;
    DisplayMemo: TMemo;
    Label1: TLabel;
    DocDirEdit: TEdit;
    Label2: TLabel;
    DefaultDocEdit: TEdit;
    StartButton: TButton;
    StopButton: TButton;
    Label3: TLabel;
    PortEdit: TEdit;
    ClientCountLabel: TLabel;
    Label5: TLabel;
    ClearButton: TButton;
    DisplayHeaderCheckBox: TCheckBox;
    Server: TElHttpsServer;
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure ServerGetDocument(Sender, Client: TObject;
      var Flags: THttpGetFlag);
    procedure StartButtonClick(Sender: TObject);
    procedure StopButtonClick(Sender: TObject);
    procedure ServerClientConnect(Sender: TObject;
      Client: TObject; Error: Word);
    procedure ServerClientDisconnect(Sender: TObject;
      Client: TObject; Error: Word);
    procedure ServerServerStarted(Sender: TObject);
    procedure ServerServerStopped(Sender: TObject);
    procedure ServerHeadDocument(Sender, Client: TObject;
      var Flags: THttpGetFlag);
    procedure ServerPostedData(Sender: TObject;
      Client: TObject; Error: Word);
    procedure ServerPostDocument(Sender, Client: TObject;
      var Flags: THttpGetFlag);
    procedure ClearButtonClick(Sender: TObject);
  private
    FIniFileName: string;
    FInitialized: Boolean;
    FCountRequests: Integer;

    CertStorage : TElMemoryCertStorage;

    procedure CreateVirtualDocument_time_htm(Sender: TObject;
      Client: TObject;
      var Flags: THttpGetFlag);
    procedure DisplayHeader(Client: TMyHttpConnection);
    procedure ProcessPostedData_CgiFrm1(Client: TMyHttpConnection);
  public
    procedure Display(Msg: string);
    property IniFileName: string read FIniFileName write FIniFileName;
  end;

var
  AppBaseForm: TAppBaseForm;

implementation

{$R *.DFM}

{$R cert.res}

const
    { IniFile layout for persistent data }
  SectionWindow = 'WindowMain';
  KeyTop = 'Top';
  KeyLeft = 'Left';
  KeyWidth = 'Width';
  KeyHeight = 'Height';
  SectionData = 'Data';
  KeyDocDir = 'DocDir';
  KeyDefaultDoc = 'DefaultDoc';
  KeyPort = 'Port';
  KeyDisplayHeader = 'DisplayHeader';

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

procedure TAppBaseForm.FormCreate(Sender: TObject);
var
  Stream : TResourceStream;
  CertBuf : array of byte;
  I : integer;
  TmpX509Cert : TElX509Certificate;

begin
  CertStorage := TElMemoryCertStorage.Create(Self);
  TmpX509Cert := TElX509Certificate.Create(nil);

  Stream := TResourceStream.CreateFromId(HINSTANCE, 103, PChar('CERTIFICATE'));
  try
    I := TmpX509Cert.LoadFromStreamPFX(Stream, 'password');
  finally
    Stream.Free;
  end;
  if I <> 0 then
  begin
    ShowMessage('Error loading internal certificate');
    Close;
  end;
  CertStorage.Add(TmpX509Cert);
  Server.CertStorage := CertStorage;

  { Create IniFileName based on EXE file name; }
  FIniFileName := LowerCase(Application.ExeName);
  FIniFileName := Copy(FIniFileName, 1, Length(FIniFileName) - 3) + 'ini';
end;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

procedure TAppBaseForm.FormShow(Sender: TObject);
var
  IniFile: TIniFile;
begin
  if not FInitialized then
  begin
    FInitialized := TRUE;

        { Restore persistent data from INI file }
    IniFile := TIniFile.Create(FIniFileName);
    Width := IniFile.ReadInteger(SectionWindow, KeyWidth, Width);
    Height := IniFile.ReadInteger(SectionWindow, KeyHeight, Height);
    Top := IniFile.ReadInteger(SectionWindow, KeyTop,
      (Screen.Height - Height) div 2);
    Left := IniFile.ReadInteger(SectionWindow, KeyLeft,
      (Screen.Width - Width) div 2);
    DocDirEdit.Text := IniFile.ReadString(SectionData, KeyDocDir,
      'c:\inetpub\wwwroot');
    DefaultDocEdit.Text := IniFile.ReadString(SectionData, KeyDefaultDoc,
      'index.html');
    PortEdit.Text := IniFile.ReadString(SectionData, KeyPort,
      '443');
    DisplayHeaderCheckBox.Checked :=
      Boolean(IniFile.ReadInteger(SectionData, KeyDisplayHeader, 0));
    IniFile.Destroy;
        { Initialize client count caption }
    ClientCountLabel.Caption := '0';
        { Display version info for program and use components }
    DisplayMemo.Clear;
    Display(CopyRight);
    Display('Using:');
    Display('   ' + WSocket.CopyRight);
    Display('   ' + WSocketS.CopyRight);
    Display('   ' + HttpSrv.CopyRight);
    Display('    Winsock:');
    Display('        Version ' +
      Format('%d.%d', [WinsockInfo.wHighVersion shr 8,
      WinsockInfo.wHighVersion and 15]));
    Display('        ' + WinsockInfo.szDescription);
    Display('        ' + WinsockInfo.szSystemStatus);
    Display('        ' + WinsockInfo.lpVendorInfo);
        { Automatically start server }
    StartButtonClick(Self);
  end;
end;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

procedure TAppBaseForm.FormClose(Sender: TObject; var Action: TCloseAction);
var
  IniFile: TIniFile;
begin
    { Save persistent data to INI file }
  IniFile := TIniFile.Create(FIniFileName);
  IniFile.WriteInteger(SectionWindow, KeyTop, Top);
  IniFile.WriteInteger(SectionWindow, KeyLeft, Left);
  IniFile.WriteInteger(SectionWindow, KeyWidth, Width);
  IniFile.WriteInteger(SectionWindow, KeyHeight, Height);
  IniFile.WriteString(SectionData, KeyDocDir, Server.DocDir);
  IniFile.WriteString(SectionData, KeyDefaultDoc, Server.DefaultDoc);
  IniFile.WriteString(SectionData, KeyPort, Server.Port);
  IniFile.WriteInteger(SectionData, KeyDisplayHeader,
    ord(DisplayHeaderCheckBox.Checked));
  IniFile.Destroy;
end;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Display a message in display memo box, making sure we don't overflow it.  }

procedure TAppBaseForm.Display(Msg: string);
begin
  DisplayMemo.Lines.BeginUpdate;
  try
    if DisplayMemo.Lines.Count > 200 then
    begin
            { We preserve only 200 lines }
      while DisplayMemo.Lines.Count > 200 do
        DisplayMemo.Lines.Delete(0);
    end;
    DisplayMemo.Lines.Add(Msg);
  finally
    DisplayMemo.Lines.EndUpdate;
        { Makes last line visible }
    SendMessage(DisplayMemo.Handle, EM_SCROLLCARET, 0, 0);
  end;
end;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This event handler is called when user clicks on start button. It is also }
{ called from FormShow event handler, at program startup. It starts server. }
{ We need to pass default document, document directory and client class     }
{ to HTTP server component. Client class is very usefull because it         }
{ instruct server component to instanciate our own client class instead of  }
{ defualt client class. Using our own client class will enables you to add  }
{ any data we need to handle our application. This data is private for each }
{ client.                                                                   }
{ When server is started, we will get OnServerStarted event triggered.      }

procedure TAppBaseForm.StartButtonClick(Sender: TObject);
begin
  Server.DocDir := Trim(DocDirEdit.Text);
  Server.DefaultDoc := Trim(DefaultDocEdit.Text);
  Server.Port := Trim(PortEdit.Text);
  Server.ClientClass := TMyHttpConnection;
  Server.Start;
end;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This event handler is triggered when user clicks on stop button. We just  }
{ stop the server. We will get OnServerStopped event triggered.             }

procedure TAppBaseForm.StopButtonClick(Sender: TObject);
begin
  Server.Stop;
end;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This event handler is triggered when user clicks on clear buttoN; We just }
{ clear the memo used for displaying activity.                              }

procedure TAppBaseForm.ClearButtonClick(Sender: TObject);
begin
  DisplayMemo.Clear;
end;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This event handler is triggered when HTTP server is started, that is when }
{ server socket has started listening.                                      }

procedure TAppBaseForm.ServerServerStarted(Sender: TObject);
begin
  DocDirEdit.Enabled := FALSE;
  DefaultDocEdit.Enabled := FALSE;
  PortEdit.Enabled := FALSE;
  StartButton.Enabled := FALSE;
  StopButton.Enabled := TRUE;
  Display('Server is waiting for connections');
end;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This event handler is triggered when server has been stopped, that is     }
{ when server socket stop listening.                                        }

procedure TAppBaseForm.ServerServerStopped(Sender: TObject);
begin
  DocDirEdit.Enabled := TRUE;
  DefaultDocEdit.Enabled := TRUE;
  PortEdit.Enabled := TRUE;
  StartButton.Enabled := TRUE;
  StopButton.Enabled := FALSE;
  Display('Server stopped');
end;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This event handler is triggered when a new client has connected.          }

procedure TAppBaseForm.ServerClientConnect(
  Sender: TObject; { HTTP server component                 }
  Client: TObject; { Client connecting                     }
  Error: Word); { Error in connection                   }
begin
  ClientCountLabel.Caption := IntToStr(Server.ClientCount);
end;