webserver.pas

IntraWeb电影程序 B/S类型的演示 Delphi+Internet 开发的电影服务器 系统登录电影网站的用户名和密码都是admin 观看电影的最低要求: 请确保你的系统已经安装媒体播放

unit WebServer;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Menus, RzButton, RzEdit, RzTray, IWStandAloneServer,Registry,
  ExtCtrls,WinSock,ShellAPI, RzPanel, RzSplit;

type
  TForm2 = class(TForm)
    IWStandAloneServer1: TIWStandAloneServer;
    RzTrayIcon1: TRzTrayIcon;
    mmoLog1: TRzMemo;
    RzButton1: TRzButton;
    RzButton2: TRzButton;
    pm1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    v1: TMenuItem;
    tmr1: TTimer;
    RzSizePanel1: TRzSizePanel;
    r1: TMenuItem;
    N4: TMenuItem;
    b1: TMenuItem;
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure v1Click(Sender: TObject);
    procedure RzTrayIcon1LButtonDblClick(Sender: TObject);
    procedure RzButton1Click(Sender: TObject);
    procedure tmr1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure IWStandAloneServer1NewSession(Sender: TObject);
    procedure IWStandAloneServer1CloseSession(Sender: TObject);
    procedure r1Click(Sender: TObject);
    procedure b1Click(Sender: TObject);
  private
    { Private declarations }
  public
    showform :Boolean;      //
    FLoginTime : TDateTime; //初次时间
    LCount: integer;    //用户数
    LIp:string;
    function GetLocalIP: string;
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation
      uses ServerController,IWGlobal;
{$R *.dfm}

function TForm2.GetLocalIP: string;
type
  TaPInAddr = array [0..10] of PInAddr;
  PaPInAddr = ^TaPInAddr;
var
  phe  : PHostEnt;
  pptr : PaPInAddr;
  Buffer : array [0..63] of char;
  I    : Integer;
  GInitData      : TWSADATA;
begin
  WSAStartup($101, GInitData);
  Result := '';
  GetHostName(Buffer, SizeOf(Buffer));
  phe :=GetHostByName(buffer);
  if phe = nil then Exit;
  pptr := PaPInAddr(Phe^.h_addr_list);
  I := 0;
  while pptr^[I] <> nil do begin
    result:=StrPas(inet_ntoa(pptr^[I]^));
    Inc(I);
  end;
  WSACleanup;
end;

procedure TForm2.N1Click(Sender: TObject);
var
  reg:tregistry;
begin
  try
   reg:=tregistry.Create;                    //
   reg.RootKey:=HKEY_LOCAL_MACHINE;
   reg.OpenKey('SOFTWARE\MicroSoft\windows\CurrentVersion\Run',true);
   reg.writestring('Films',application.ExeName);
   finally
    reg.free;
  end;
end;

procedure TForm2.N2Click(Sender: TObject);
var
  reg:tregistry;
begin
 try
  reg:=tregistry.Create;
  reg.RootKey:=HKEY_LOCAL_MACHINE;
  reg.OpenKey('SOFTWARE\MicroSoft\windows\CurrentVersion\Run',true);
  reg.DeleteValue('Films');
 finally
  reg.free;
 end;
end;

procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action:=canone;
  windows.ShowWindow(application.Handle,sw_hide);
  windows.ShowWindow(form2.Handle,sw_hide);
  showform:=true;
end;

procedure TForm2.v1Click(Sender: TObject);
begin
if Sender is TRzButton then begin
  windows.ShowWindow(application.Handle,sw_hide);
  windows.ShowWindow(form2.Handle,sw_hide);
  showform:=true;
end
else begin
   if MessageDlg('你确定要关闭服务器吗?',mtinformation, [mbYes, mbNo],0) = mrYes then
   begin
    Application.Terminate;
   end;
end;

end;

procedure TForm2.RzTrayIcon1LButtonDblClick(Sender: TObject);
begin
if showform=true then
 begin
  windows.ShowWindow(application.Handle,SW_SHOWNORMAL);
  windows.ShowWindow(form2.Handle,SW_SHOWNORMAL);
   showform:=false;
 end
 else
  begin
   windows.ShowWindow(application.Handle,sw_hide);
   windows.ShowWindow(form2.Handle,sw_hide);
    showform:=true;
  end;
end;

procedure TForm2.RzButton1Click(Sender: TObject);
begin
//IWStandAloneServer1.Run;
 if GServerController.Port=80 then
   ShellExecute(handle,pchar('open'),pchar('IEXPLORE.EXE'),pchar('http://'+Lip+'?admin=administrator'),nil,SW_NORMAL)
 else
   ShellExecute(handle,pchar('open'),pchar('IEXPLORE.EXE'),pchar('http://'+Lip+':'+IntToStr(GServerController.Port)+'?admin=administrator'),nil,SW_NORMAL);
end;

procedure TForm2.tmr1Timer(Sender: TObject);
var
  strLoginTime:string;       //显示当前登录时间的字符串
  calculateTime:Double ;     //用于生成strLoginTime的临时变量
begin 
calculateTime := now -form2.FLoginTime ;
StrLoginTime := IntToStr(trunc(calculateTime)) + '天';
calculateTime :=( calculateTime -trunc(calculateTime)) *24;
StrLoginTime := StrLoginTime + IntToStr(trunc(calculateTime)) + '小时';
calculateTime :=( calculateTime -trunc(calculateTime)) *60;
StrLoginTime := StrLoginTime + IntToStr(trunc(calculateTime)) + '分钟';
calculateTime :=( calculateTime -trunc(calculateTime)) *60;
StrLoginTime := StrLoginTime + IntToStr(trunc(calculateTime)) + '秒';
mmoLog1.Clear;
mmoLog1.Lines.Add('');
mmoLog1.Lines.Add(' 当前端口: ' + IntToStr(GServerController.Port));
mmoLog1.Lines.Add('');
mmoLog1.Lines.Add(' 当前共有:'+inttostr(LCount)+' 用户在线!');
mmoLog1.Lines.Add('');
mmoLog1.Lines.Add(' 已启动:'+StrLoginTime );
mmoLog1.Lines.Add( '' );
mmoLog1.Lines.Add(' 现在时间:' + DateTimeToStr(Now));
mmoLog1.Lines.Add('');
mmoLog1.Lines.Add(' 访问本服务器的超级连接:');
if GServerController.Port=80 then
mmoLog1.Lines.Add(' http://'+Lip)
else
mmoLog1.Lines.Add(' http://'+Lip+':'+IntToStr(GServerController.Port));
mmoLog1.Lines.Add('               双击登录!:');
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
FLoginTime :=Now;
showform:=true;
LCount:=0;
LIp:=GetLocalIP; 
end;

procedure TForm2.IWStandAloneServer1NewSession(Sender: TObject);
begin
  Inc(LCount);
end;

procedure TForm2.IWStandAloneServer1CloseSession(Sender: TObject);
begin
  LCount:=LCount-1;
end;

procedure TForm2.r1Click(Sender: TObject);
begin
 windows.ShowWindow(application.Handle,SW_SHOWNORMAL);
  windows.ShowWindow(form2.Handle,SW_SHOWNORMAL);
   showform:=false;
end;

procedure TForm2.b1Click(Sender: TObject);
begin
 windows.ShowWindow(application.Handle,sw_hide);
   windows.ShowWindow(form2.Handle,sw_hide);
    showform:=true;
end;

end.