webserv1.pas

ics Internet 控件

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TWebServForm.FormShow(Sender: TObject);
var
    IniFile : TIniFile;
    wsi     : TWSADATA;
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:\WwwRoot');
        DefaultDocEdit.Text := IniFile.ReadString(SectionData, KeyDefaultDoc,
                                                  'index.html');
        PortEdit.Text       := IniFile.ReadString(SectionData, KeyPort,
                                                  '80');
        RedirUrlEdit.Text   := IniFile.ReadString(SectionData, KeyRedirUrl,
                                                  '/time.htm');
        DirListCheckBox.Checked :=
                Boolean(IniFile.ReadInteger(SectionData, KeyDirList, 1));
        OutsideRootCheckBox.Checked :=
                Boolean(IniFile.ReadInteger(SectionData, KeyOutsideRoot, 0));
        DisplayHeaderCheckBox.Checked :=
                Boolean(IniFile.ReadInteger(SectionData, KeyDisplayHeader, 0));
        WriteLogFileCheckBox.Checked :=
                Boolean(IniFile.ReadInteger(SectionData, KeyLogToFile, 0));
        IniFile.Destroy;
        { Start log file }
        if WriteLogFileCheckBox.Checked then begin
            OpenLogFile;
            WriteLogFileCheckBox.Checked := FLogFileOpened;
        end;
        { Initialize client count caption }
        ClientCountLabel.Caption := '0';
        { Display version info for program and used components }
        wsi := WinsockInfo;
        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('        ' + StrPas(@wsi.szDescription));
        Display('        ' + StrPas(@wsi.szSystemStatus));
{$IFNDEF VER100}
        { A bug in Delphi 3 makes lpVendorInfo invalid }
        if wsi.lpVendorInfo <> nil then
            Display('        ' + StrPas(wsi.lpVendorInfo));
{$ENDIF}
        { Automatically start server }
        StartButtonClick(Self);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TWebServForm.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,      HttpServer1.DocDir);
    IniFile.WriteString(SectionData,    KeyDefaultDoc,  HttpServer1.DefaultDoc);
    IniFile.WriteString(SectionData,    KeyPort,        HttpServer1.Port);
    IniFile.WriteString(SectionData,    KeyRedirUrl,    RedirUrlEdit.Text);
    IniFile.WriteInteger(SectionData,   KeyDirList,
                                        Ord(DirListCheckBox.Checked));
    IniFile.WriteInteger(SectionData,   KeyOutsideRoot,
                                        Ord(OutsideRootCheckBox.Checked));
    IniFile.WriteInteger(SectionData,   KeyDisplayHeader,
                                        Ord(DisplayHeaderCheckBox.Checked));
    IniFile.WriteInteger(SectionData,   KeyLogToFile,
                                        Ord(WriteLogFileCheckBox.Checked));
    IniFile.Destroy;
    CloseLogFile;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Display a message in display memo box, making sure we don't overflow it.  }
procedure TWebServForm.Display(Msg : String);
begin
    DisplayMemo.Lines.BeginUpdate;
    try
        { We preserve only 200 lines }
        while DisplayMemo.Lines.Count > 200 do
            DisplayMemo.Lines.Delete(0);
        DisplayMemo.Lines.Add(Msg);
    finally
        DisplayMemo.Lines.EndUpdate;
        { Makes last line visible }
        {$IFNDEF VER80}
        SendMessage(DisplayMemo.Handle, EM_SCROLLCARET, 0, 0);
        {$ENDIF}
    end;
    if FLogFileOpened then begin
        try
            WriteLn(FLogFile, Msg);
        except
            on E:Exception do begin
                DisplayMemo.Lines.Add('*** Exception' +
                                      E.CLassName + ': ' + E.Message +
                                      ' writing to log file ***');
            end;
        end;
    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 TWebServForm.StartButtonClick(Sender: TObject);
begin
    if DirListCheckBox.Checked then
        HttpServer1.Options := HttpServer1.Options + [hoAllowDirList]
    else
        HttpServer1.Options := HttpServer1.Options - [hoAllowDirList];
    if OutsideRootCheckBox.Checked then
        HttpServer1.Options := HttpServer1.Options + [hoAllowOutsideRoot]
    else
        HttpServer1.Options := HttpServer1.Options - [hoAllowOutsideRoot];

    HttpServer1.DocDir      := Trim(DocDirEdit.Text);
    HttpServer1.DefaultDoc  := Trim(DefaultDocEdit.Text);
    HttpServer1.Port        := Trim(PortEdit.Text);
    HttpServer1.ClientClass := TMyHttpConnection;
    try
        HttpServer1.Start;
    except
        on E:Exception do begin
            Display('**** Unable to start server ****');
            if HttpServer1.WSocketServer.LastError = WSAEADDRINUSE then
                Display('**** Port ' + HttpServer1.Port +
                        ' already used by another application ****')
            else
                Display('**** ' + E.ClassName + ': ' + E.Message + ' ****');
        end;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This event handler is triggered when user clicks on stop button. We just  }
{ stop the server. We will get OnServerStopped event triggered.             }
procedure TWebServForm.StopButtonClick(Sender: TObject);
begin
    HttpServer1.Stop;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This event handler is triggered when user clicks on clear buttoN; We just }
{ clear the memo used for displaying activity.                              }
procedure TWebServForm.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 TWebServForm.HttpServer1ServerStarted(Sender: TObject);
var
    DemoUrl : String;
begin
    DocDirEdit.Enabled          := FALSE;
    DefaultDocEdit.Enabled      := FALSE;
    DirListCheckBox.Enabled     := FALSE;
    OutsideRootCheckBox.Enabled := FALSE;
    PortEdit.Enabled            := FALSE;
    StartButton.Enabled         := FALSE;
    StopButton.Enabled          := TRUE;
    Display('Server is waiting for connections on port ' + HttpServer1.Port);

    DemoUrl := 'http://' + LowerCase(LocalHostName);
    if (HttpServer1.Port <> '80') and (HttpServer1.Port <> 'http') then
        DemoUrl := DemoUrl + ':' + HttpServer1.Port;
    DemoUrl := DemoUrl + '/demo.htm';

    Display('Point your browser to ' + DemoUrl);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This event handler is triggered when server has been stopped, that is     }
{ when server socket stop listening.                                        }
procedure TWebServForm.HttpServer1ServerStopped(Sender: TObject);
begin
    DocDirEdit.Enabled          := TRUE;
    DefaultDocEdit.Enabled      := TRUE;
    DirListCheckBox.Enabled     := TRUE;
    OutsideRootCheckBox.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 TWebServForm.HttpServer1ClientConnect(
    Sender : TObject;               { HTTP server component                 }
    Client : TObject;               { Client connecting                     }
    Error  : Word);                 { Error in connection                   }
begin
    ClientCountLabel.Caption := IntToStr(HttpServer1.ClientCount);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This event handler is triggered when a client is disconnecting, just      }
{ before client component is closed.                                        }
procedure TWebServForm.HttpServer1ClientDisconnect(
    Sender : TObject;               { HTTP server component                 }
    Client : TObject;               { Client connecting                     }
    Error  : Word);                 { Error in disconnection                }
begin
    ClientCountLabel.Caption := IntToStr(HttpServer1.ClientCount - 1);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This event handler is triggered when HTTP server component receive a HEAD }
{ command from any client.                                                  }
{ We just count the request, display a message and let HTTP server          }
{ component handle everything.                                              }
{ We should trap every URI we handle internally...                          }
procedure TWebServForm.HttpServer1HeadDocument(
    Sender    : TObject;            { HTTP server component                 }
    Client    : TObject;            { Client connection issuing command     }
    var Flags : THttpGetFlag);      { Tells what HTTP server has to do next }
var
    ClientCnx  : TMyHttpConnection;
begin
    { It's easyer to do the cast one time. Could use with clause... }
    ClientCnx := TMyHttpConnection(Client);
    Inc(FCountRequests);
    Display('[' + FormatDateTime('HH:NN:SS', Now) + ' ' +
            ClientCnx.GetPeerAddr + '] ' + IntToStr(FCountRequests) +
            ': ' + ClientCnx.Version + ' HEAD ' + ClientCnx.Path);