⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 unit1.pas

📁 Delphi快速开发Web Server
💻 PAS
字号:
🔍 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes,
  Graphics, Controls, Forms, FileCtrl,
  Dialogs, StdCtrls,

  rtcDataSrv, rtcInfo, rtcConn, rtcHttpSrv;

type
  TForm1 = class(TForm)
    RtcHttpServer1: TRtcHttpServer;
    RtcDataProvider1: TRtcDataProvider;
    Label1: TLabel;
    eSrvPort: TEdit;
    Label2: TLabel;
    btnListen: TButton;
    Label3: TLabel;
    eUploadFolder: TEdit;
    RtcDataProvider2: TRtcDataProvider;
    procedure FormCreate(Sender: TObject);
    procedure RtcDataProvider1CheckRequest(Sender: TRtcConnection);
    procedure RtcDataProvider1DataReceived(Sender: TRtcConnection);
    procedure btnListenClick(Sender: TObject);
    procedure RtcHttpServer1ListenStart(Sender: TRtcConnection);
    procedure RtcHttpServer1ListenStop(Sender: TRtcConnection);
    procedure RtcDataProvider2CheckRequest(Sender: TRtcConnection);
    procedure RtcDataProvider2DataReceived(Sender: TRtcConnection);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
RtcHttpServer1.Listen;
end;

procedure TForm1.RtcDataProvider1CheckRequest(Sender: TRtcConnection);
  begin
  with TRtcDataServer(Sender) do
    if UpperCase(Request.FileName)='/UPLOAD' then
      Accept;
  end;

procedure TForm1.RtcDataProvider1DataReceived(Sender: TRtcConnection);
  begin
  with TRtcDataServer(Sender) do
    begin
    if Request.Method='GET' then
      begin
      Write('<form enctype="multipart/form-data" method="post">');
      Write('Type some text, if you like:<br>');
      Write('<input type="text" name="textline" size="30"><br>');
      Write('Please specify a file to upload:<br>');
      Write('<input type="file" name="datafile" size="40"><br>');
      Write('<input type="submit" value="Send">');
      Write('</form>');
      end
    else
      begin
      Request.Params.AddText(Read);
      if Request.Complete then
        begin
        Write('<html><body>');

        if Request.Params['textline']<>'' then
          Write('You typed this text: <br> '+Request.Params['textline']+'<br><br>');

        if Request.Params['datafile']<>'' then
          begin
          if not DirectoryExists(eUploadFolder.Text) then
            CreateDir(eUploadFolder.Text);
          if Request.Params.GetFile('datafile', eUploadFolder.Text+'\'+ExtractFileName(Request.Params['datafile'])) then
            Write('File "'+Request.Params.Value['datafile']+'" was uploaded to server.')
          else
            Write('Error receiving File "'+Request.Params.Value['datafile']+'".');
          end
        else
          Write('No file uploaded (DataFile parameter empty).');

        Write('</body></html>');
        end;
      end;
    end;
  end;

procedure TForm1.btnListenClick(Sender: TObject);
  begin
  if RtcHttpServer1.isListening then
    RtcHttpServer1.StopListen
  else
    begin
    RtcHttpServer1.ServerPort:=eSrvPort.Text;
    RtcHttpServer1.Listen;
    end;
  end;

procedure TForm1.RtcHttpServer1ListenStart(Sender: TRtcConnection);
  begin
  Caption:='Server listening ...';
  btnListen.Caption:='Stop Listen';
  end;

procedure TForm1.RtcHttpServer1ListenStop(Sender: TRtcConnection);
  begin
  Caption:='Idle (not listening)';
  btnListen.Caption:='Listen';
  end;

procedure TForm1.RtcDataProvider2CheckRequest(Sender: TRtcConnection);
  begin
  with TRtcDataServer(Sender) do
    if UpperCase(Request.FileName)='/GUESS' then
      Accept;
  end;

procedure TForm1.RtcDataProvider2DataReceived(Sender: TRtcConnection);
begin
with TRtcDataServer(Sender) do
  begin
  if Request.Method='GET' then
    begin
    if Request.Complete then
      begin
      Write('<html>');
      Write('<form name="frm" enctype="multipart/form-data" method="post">');
      Write('Guess a number between 0 and 9:<br>');
      Write('<input type="text" name="yourguess" size="30" selected><br>');
      Write('</form>');
      // we want our edit box to receive the focus ...
      Write('<script language="JavaScript">document.frm.yourguess.focus();</script>');
      Write('</html>');
      // Open a new Session for the user
      OpenSession;
      // we want to keep the session alive for at least 240 seconds (4 minutes)
      // to give the user 4 minutes time to think of a number
      Session.KeepAlive:=240;
      // generate a random number and store it in the session
      Session.asInteger['mynum']:=random(10);
      // send the Session ID to the browser
      Response.Cookie['sid']:=Session.ID;
      end;
    end
  else
    begin
    Request.Params.AddText(Read);
    if Request.Complete then
      begin
      if not FindSession(Request.Cookie['sid']) then
        begin
        Write('Your session has expired.<br>');
        Write('Please click <a href="/guess">here</a> to try again.');
        end
      else
        begin
        Session.asInteger['try']:=Session.asInteger['try']+1;
        if Session.asString['mynum']=Request.Params['yourguess'] then
          begin
          Write('Congratulations! You have guessed it!<br>');
          Write('And you needed only '+Session.asString['try']+' tries.<br>');
          Write('Want to play again? <a href="/guess">Click here.</a>');
          end
        else
          begin
          Write('<html><form name="frm" enctype="multipart/form-data" method="post">');
          Write('Sorry, wrong. This was your guess nr. '+Session.asString['try']+'<br>');
          Write('What would be your next guess?<br>');
          Write('<input type="text" name="yourguess" size="30"><br>');
          Write('</form>');
          Write('<script language="JavaScript">document.frm.yourguess.focus();</script>');
          Write('</html>');
          end;
        end;
      end;
    end;
  end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -