unit1.pas

计算机网络与通信的知识

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes,  Controls, Forms, Dialogs,
  Psock, StdCtrls, ScktComp,ServerThread, Buttons,FileCtrl,
  registry, Menus, ExtCtrls,Shellapi, Graphics;
  
const
  WM_TRAYNOTIFY=WM_USER+1;//定义通知消息
  
type
  TForm1 = class(TForm)
    ServerSocket1: TServerSocket;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    historylistbox: TListBox;
    PopupMenu1: TPopupMenu;
    N12: TMenuItem;
    Timer1: TTimer;
    Image1: TImage;
    PopupMenu2: TPopupMenu;
    N11: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    procedure ServerSocket1GetThread(Sender: TObject;
      ClientSocket: TServerClientWinSocket;
      var SocketThread: TServerClientThread);
    procedure ServerSocket1ThreadEnd(Sender: TObject;
      Thread: TServerClientThread);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure MainMenu1Change(Sender: TObject; Source: TMenuItem;
      Rebuild: Boolean);
    procedure N2Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure N12Click(Sender: TObject);
    procedure N9Click(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure WndProc(var Msg: TMessage); override;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure N13Click(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure N14Click(Sender: TObject);
  private

  public
    function rigisterhttpserver:integer;
    function savefile:integer;
    procedure ApppendToSysTemMenu(Form:TForm;Item:String;itemid:word);
    procedure registermsg(var msg: Tmsg; var handled: boolean);
    function terminatestreads: integer;
  end;

var
  Form1: TForm1;
  rootdir:string;
  serverport:string;
  defaultpage:string;
  backdir:string;
  intervaltime:string;
  nd:NotifyIconData;
  cache:TThreadlist;
implementation

uses Unit2, Unit3;

{$R *.DFM}
procedure TForm1.registermsg(var msg: Tmsg; var handled: boolean);
begin
  if msg.message =WM_syscommand then
    if msg.wparam=79 then
        n9.Click;  
end;
procedure TForm1.ApppendToSysTemMenu(Form:TForm;Item:String;itemid:word);
var
  normalsysmenu,minimizedmenu:hmenu;
  aitem:array[0..255] of char;
  pitem:pchar;
begin
  normalsysmenu:=getsystemmenu(form.handle,false);
  minimizedmenu:=getsystemmenu(Application.Handle ,false);
  if item='-' then
  begin
    appendmenu(normalsysmenu,mf_separator,0,nil);
    appendmenu(minimizedmenu,mf_separator,0,nil);
  end
  else
  begin
    pitem:=strpcopy(@Aitem,item);
    appendmenu(normalsysmenu,MF_STRING,ItemID,PItem);
    appendmenu(minimizedmenu,MF_STRING,ItemID,PItem);
  end;
end;
function Tform1.savefile:integer;
var
flname,tf:string;
f:Textfile;
test:Tstringlist;
begin
tf:=copy(backdir,length(backdir),1);
if tf='\' then
    flname:=backdir+datetostr(date)+'log.txt'
else
    flname:=backdir+'\'+datetostr(date)+'log.txt';
if not(FileExists(flname)) then
    begin
    test:=Tstringlist.Create;
    test.SaveToFile(flname);
    test.Free;
    end;
AssignFile(F,flname);
Append(f);
flname:=self.historylistbox.Items.Text;
if flname<>'' then
    Write(f,flname);
Flush(f);
CloseFile(F);
self.historylistbox.Clear;
end;

procedure TForm1.WndProc(var Msg: TMessage);
var
  IconID:integer;
  pt:TPOINT;
begin
  if msg.Msg = WM_TRAYNOTIFY then
  begin
  {
  在通知消息中，wParam参数为图标的uID，
  lParam参数为鼠标事件的类型。
  }
    iconID := msg.WParam;
    //获取鼠标的在屏幕上的位置
    GetCursorPos(pt);

  //通知消息的处理的基本框架结构如下：
    case msg.lParam of
      WM_LBUTTONDOWN:
      begin
        //鼠标左键被按下
      end;
      WM_RBUTTONDOWN:
      begin
        //鼠标右键被按下
        PopupMenu2.Popup((mouse.CursorPos.x),(mouse.CursorPos.y));
      end;
      WM_LBUTTONUP:
      begin
        //释放鼠标左键
      end;
      WM_RBUTTONUP:
      begin
        //释放鼠标右键
      end;
      WM_MOUSEMOVE:
      begin
        //鼠标在图标上移动
      end;
      WM_LBUTTONDBLCLK:
      begin
        //鼠标左键双击
      end;
      WM_RBUTTONDBLCLK:
      begin
        //鼠标右键双击
      end;
    end; //end case
  end
  else//调用父类的WndProc方法处理其它消息
    inherited;
end;

function TForm1.rigisterhttpserver:integer;
var
  RegF:TRegistry;
  tmp:string;
begin
    RegF:=TRegistry.Create;
    RegF.RootKey:=HKEY_LOCAL_MACHINE;
    RegF.OpenKey('Software\dcs\httpserver',true);
    rootdir:=RegF.ReadString('rootdir');
    tmp:=copy(rootdir,length(rootdir),1);
    if ((tmp='/') or (tmp='\')) then
        rootdir:=copy(rootdir,1,length(rootdir)-1);
    serverport:=RegF.ReadString('port');
    defaultpage:=RegF.ReadString('defaultpage');
    backdir:=RegF.ReadString('backdir');
    intervaltime:=RegF.ReadString('intervaltime');
    if ((rootdir='') or (serverport='') or (defaultpage='')) then
        begin
        form2.ShowModal;
        end;
    RegF.CloseKey;
    RegF.Free;
    try
    if intervaltime='0' then
        timer1.Enabled:=false
    else
        begin
        timer1.Interval:=strtoint(intervaltime)*60*1000;
        timer1.Enabled:=true;
        end;
    except
    end;
end;
procedure TForm1.ServerSocket1GetThread(Sender: TObject;
  ClientSocket: TServerClientWinSocket;
  var SocketThread: TServerClientThread);
begin
  SocketThread:=TServerThread.Create(false,ClientSocket);
  cache.Add(SocketThread);
end;

procedure TForm1.ServerSocket1ThreadEnd(Sender: TObject;
  Thread: TServerClientThread);
var
i:integer;
begin
with cache.LockList do
    begin
    for i:=0 to count-1 do
        begin
        if Thread=Items[i] then
            begin
            Delete(i);
            exit;
            end;
        end;
    end;
cache.UnlockList;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  Application.Initialize();
  application.ShowMainForm:=false;
  ShowWindow(Application.Handle, SW_HIDE);
  form1.Hide;
  application.Run;
end;

procedure TForm1.FormCreate(Sender: TObject);
const
title1='杜长';
begin
  ApppendToSysTemMenu(Form1,'-',78);
  ApppendToSysTemMenu(Form1,'关于软件',79);
  Application.OnMessage:=form1.Registermsg;
  form1.Caption:=title1+'胜'+' dcs-httpserver';
  nd.cbSize := sizeof(NotifyIconData);
  nd.Wnd := handle;
  nd.uID := 0;
  nd.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
  nd.uCallbackMessage := WM_TRAYNOTIFY;
  nd.hIcon:=image1.Picture.Icon.Handle;
  StrPLCopy(nd.szTip, '杜长胜-httpServer1.0', 63);
  Shell_NotifyIcon(NIM_ADD, @nd);
  cache:=TThreadlist.Create;
end;

procedure TForm1.MainMenu1Change(Sender: TObject; Source: TMenuItem;
  Rebuild: Boolean);
begin
if ServerSocket1.Active then
    N2.Caption:='关闭服务'
else
    N2.Caption:='打开服务';
end;

procedure TForm1.N2Click(Sender: TObject);
var
i:integer;
begin
if ServerSocket1.Active then
    begin
    terminatestreads;
    ServerSocket1.Close;
    self.historylistbox.Items.Append('              '+datetimetostr(now)+'  关闭服务！');
    end
else
    begin
    try
        rigisterhttpserver;
        Serversocket1.Port:=strtoint(serverport);
        Serversocket1.Open;
        self.historylistbox.Items.Append('              '+datetimetostr(now)+'  打开服务！');
    except
        application.MessageBox('端口被占用','打开错误',MB_OK+MB_ICONERROR);
    end;
    end;
end;

procedure TForm1.N5Click(Sender: TObject);
Var
RegF:TRegistry;
begin
    RegF:=TRegistry.Create;
    RegF.RootKey:=HKEY_LOCAL_MACHINE;
    RegF.OpenKey('SOFTWARE\dcs\httpserver',True);
    form2.Edit1.Text:=RegF.ReadString('rootdir');
    form2.edit2.text:=RegF.readstring('port');
    form2.edit3.text:=RegF.ReadString('backdir');
    form2.edit4.text:=RegF.ReadString('intervaltime');
    form2.edit5.text:=RegF.ReadString('defaultpage');
    RegF.CloseKey;
    RegF.Free;
    form2.ShowModal;
end;

procedure TForm1.N3Click(Sender: TObject);
begin
savefile;
Shell_NotifyIcon(NIM_DELETE, @nd);
terminatestreads;
self.ServerSocket1.Close;
application.Terminate;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
rigisterhttpserver;
self.OnActivate:=nil;
end;

procedure TForm1.N12Click(Sender: TObject);
begin
if MessageBox(0,Pchar('清除日志前保存么？'),'清除日志',MB_YESNO+MB_ICONQUESTION)=IDYES then
    savefile
else
    historylistbox.Clear;
end;

procedure TForm1.N9Click(Sender: TObject);
begin
AboutBox.showmodal;
end;

procedure TForm1.N10Click(Sender: TObject);
begin
MessageBox(0,PChar('按照设置就可以了'),'怎样操作',MB_OK);
end;

procedure TForm1.N7Click(Sender: TObject);
begin
n12.Click;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Shell_NotifyIcon(NIM_DELETE, @nd);
cache.Free;
end;

procedure TForm1.N13Click(Sender: TObject);
begin
n3.Click;
end;

procedure TForm1.N11Click(Sender: TObject);
begin
form1.WindowState:=wsNormal;
form1.Show;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
savefile;
end;
procedure TForm1.N14Click(Sender: TObject);
var
flname:string;
tf:string;
begin
tf:=copy(backdir,length(backdir),1);
if tf='\' then
    flname:=backdir+datetostr(date)+'log.txt'
else
    flname:=backdir+'\'+datetostr(date)+'log.txt';
if fileexists(flname) then
    shellexecute(handle,'open',pchar(flname),'"','"',sw_shownormal)
else
    MessageBox(0,Pchar('还没有记录日志！'),'查看日志',MB_OK);
end;

function TForm1.terminatestreads: integer;
var
i:integer;
sf:TThread;
begin
   with cache.LockList do
        begin
        for i:=0 to count-1 do
            begin
            sf:=Items[i];
            sf.Terminate;
            end;
        end;
    cache.UnlockList;
    cache.Clear;
    sleep(200);
end;

end.