webserv1.pas

ics Internet 控件

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

Author:       Fran鏾is PIETTE
Creation:     Oct 10, 1999
Description:  WebSrv1 show how to use THttpServer component to implement
              a web server with dynamic page capabilities. To see dynamic pages
              in action, launch the demo and point your browser to:
              http://localhost/demo.htm (replace "localhost" by the name of the
              computer where you run the demo if it is not on the same computer
              as the browser). Demo.htm is a dynamic page (that is generated
              by code) that show a menu for other dynamic pages. All dynamic
              pages are implemented in procedure whose names begins by
              "CreateVirtualDocument". See the code below.
              WARNING: The code below is for demonstration only.
              You need to add code to fit your needs about security.
              The code below allows to get all files on the computer running
              the demo. Add code in OnGetDocument, OnHeadDocument and
              OnPostDocument to check for authorized access to files.
Version:      1.08
EMail:        [e-mail]  http://www.overbyte.be
              [e-mail]      http://www.rtfm.be/fpiette
                                           [e-mail]
Support:      Use the mailing list [e-mail]
              Follow "support" link at http://www.overbyte.be for subscription.
Legal issues: Copyright (C) 1999-2004 by Fran鏾is PIETTE
              Rue de Grady 24, 4053 Embourg, Belgium. Fax: [phone]
              <[e-mail]>

              This software is provided 'as-is', without any express or
              implied warranty.  In no event will the author be held liable
              for any  damages arising from the use of this software.

              Permission is granted to anyone to use this software for any
              purpose, including commercial applications, and to alter it
              and redistribute it freely, subject to the following
              restrictions:

              1. The origin of this software must not be misrepresented,
                 you must not claim that you wrote the original software.
                 If you use this software in a product, an acknowledgment
                 in the product documentation would be appreciated but is
                 not required.

              2. Altered source versions must be plainly marked as such, and
                 must not be misrepresented as being the original software.

              3. This notice may not be removed or altered from any source
                 distribution.

              4. You must register this software by sending a picture postcard
                 to the author. Use a nice stamp and mention your name, street
                 address, EMail address and any comment you like to say.

History:
May 21, 2000 V1.01 Worked around a bug with Delphi 3 and lpVendorInfo
Oct 07, 2001 V1.02 Added Logfile feature
                   Added display if time and IP Addr for GET command.
Feb 15, 2003 V1.03 Call PostedDataReceived so that things are handled
                   correctly with HTTP 1.1 version.
Mar 11, 2003 V1.04 Changer LingerOnOff to LingerNotSet (Wilfried)
Jan 03, 2004 V1.05 Added DirList feature checkbox
Jan 15, 2004 V1.06 Added RedirURLEdit feature.
Jan 16, 2004 V1.07 Simplified virtual document procedure.
                   Added demo_htm, form_htm and formdata.htm virtual documents.
                   Now demo.htm link show a menu for all demonstrated features.
                   And all virtual documents are linked back to the demo menu.
                   NOTE: The code will not work properly with Delphi 1 because
                         Delphi 1 is limited to 255 character strings. To use
                         the demo, you must rewrite some code, mostly the
                         code involving the Answer method. Instead of using
                         Answer, you must prepare the complete header yourself
                         and send it using ont or more PutStringInSendBuffer,
                         and then send the document body using yet more
                         PutStringInSendBuffer or using DocStream.
Sep 11, 2004 V1.08 Added virtual page to show client IP address. The code is
                   implemented in CreateVirtualDocument_myip_htm.


 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
unit WebServ1;

{$I ICSDEFS.INC}
{$I+}             { Turn IO exceptions to on }

interface

uses
  WinTypes, WinProcs, Messages, SysUtils, Classes, Controls, Forms,
  IniFiles, StdCtrls, ExtCtrls, WinSock, WSocket, WSocketS, HttpSrv;

const
  CopyRight : String     = 'WebServ (c) 1999-2004 F. Piette V1.08 ';

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(THttpConnection)
  protected
    FPostedDataBuffer : PChar;     { Will hold dynamically allocated buffer }
    FPostedDataSize   : Integer;   { Databuffer size                        }
    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).   }
  TWebServForm = class(TForm)
    ToolsPanel: TPanel;
    DisplayMemo: TMemo;
    HttpServer1: THttpServer;
    Label1: TLabel;
    DocDirEdit: TEdit;
    Label2: TLabel;
    DefaultDocEdit: TEdit;
    StartButton: TButton;
    StopButton: TButton;
    Label3: TLabel;
    PortEdit: TEdit;
    ClientCountLabel: TLabel;
    Label5: TLabel;
    ClearButton: TButton;
    DisplayHeaderCheckBox: TCheckBox;
    WriteLogFileCheckBox: TCheckBox;
    DirListCheckBox: TCheckBox;
    OutsideRootCheckBox: TCheckBox;
    Label4: TLabel;
    RedirURLEdit: TEdit;
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure HttpServer1GetDocument(Sender, Client: TObject;
      var Flags: THttpGetFlag);
    procedure StartButtonClick(Sender: TObject);
    procedure StopButtonClick(Sender: TObject);
    procedure HttpServer1ClientConnect(Sender: TObject;
      Client: TObject; Error: Word);
    procedure HttpServer1ClientDisconnect(Sender: TObject;
      Client: TObject; Error: Word);
    procedure HttpServer1ServerStarted(Sender: TObject);
    procedure HttpServer1ServerStopped(Sender: TObject);
    procedure HttpServer1HeadDocument(Sender, Client: TObject;
      var Flags: THttpGetFlag);
    procedure HttpServer1PostedData(Sender: TObject;
      Client: TObject; Error: Word);
    procedure HttpServer1PostDocument(Sender, Client: TObject;
      var Flags: THttpGetFlag);
    procedure ClearButtonClick(Sender: TObject);
    procedure WriteLogFileCheckBoxClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FIniFileName   : String;
    FInitialized   : Boolean;
    FCountRequests : Integer;
    FLogFile       : TextFile;
    FLogFileName   : String;
    FLogFileOpened : Boolean;
    procedure CreateVirtualDocument_demo_htm(Sender    : TObject;
                                             ClientCnx : TMyHttpConnection;
                                             var Flags : THttpGetFlag);
    procedure CreateVirtualDocument_time_htm(Sender    : TObject;
                                             ClientCnx : TMyHttpConnection;
                                             var Flags : THttpGetFlag);
    procedure CreateVirtualDocument_redir_htm(Sender    : TObject;
                                              ClientCnx : TMyHttpConnection;
                                              var Flags : THttpGetFlag);
    procedure CreateVirtualDocument_form_htm(Sender    : TObject;
                                             ClientCnx : TMyHttpConnection;
                                             var Flags : THttpGetFlag);
    procedure CreateVirtualDocument_formdata_htm(Sender    : TObject;
                                                 ClientCnx : TMyHttpConnection;
                                                 var Flags : THttpGetFlag);
    procedure CreateVirtualDocument_myip_htm(Sender    : TObject;
                                             ClientCnx : TMyHttpConnection;
                                             var Flags : THttpGetFlag);
    procedure DisplayHeader(ClientCnx : TMyHttpConnection);
    procedure ProcessPostedData_FormHandler(ClientCnx : TMyHttpConnection);
    procedure CloseLogFile;
    procedure OpenLogFile;
  public
    procedure Display(Msg : String);
    property  IniFileName : String read FIniFileName write FIniFileName;
  end;

var
  WebServForm: TWebServForm;

implementation

{$R *.DFM}

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';
    KeyLogToFile       = 'LogToFile';
    KeyDirList         = 'AllowDirList';
    KeyOutsideRoot     = 'AllowOutsideRoot';
    KeyRedirUrl        = 'RedirURL';


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{$IFDEF VER80}
function TrimRight(Str : String) : String;
var
    i : Integer;
begin
    i := Length(Str);
    while (i > 0) and (Str[i] = ' ') do
        i := i - 1;
    Result := Copy(Str, 1, i);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TrimLeft(Str : String) : String;
var
    i : Integer;
begin
    if Str[1] <> ' ' then
        Result := Str
    else begin
        i := 1;
        while (i <= Length(Str)) and (Str[i] = ' ') do
            i := i + 1;
        Result := Copy(Str, i, Length(Str) - i + 1);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function Trim(Str : String) : String;
begin
    Result := TrimLeft(TrimRight(Str));
end;
{$ENDIF}


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TWebServForm.FormCreate(Sender: TObject);
begin
    { Create IniFileName based on EXE file name; }
    FIniFileName := LowerCase(ExtractFileName(Application.ExeName));
    FIniFileName := Copy(FIniFileName, 1, Length(FIniFileName) - 3) + 'ini';
    FLogFileName := Application.ExeName;
    FLogFileName := Copy(FLogFileName, 1, Length(FLogFileName) - 3) + '.log';
   {LogStream := TFileStream.Create('PDFLOG.TXT', fmCreate);}
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TWebServForm.FormDestroy(Sender: TObject);
begin
   {LogStream.Free;}
   {LogStream := nil;}
end;