大家帮我看看这段代码啊(0分)

D

dlbasin

Unregistered / Unconfirmed
GUEST, unregistred user!
主要是nd.hIcon:=image1.Picture.Icon.Handle;中的图标是从哪里装入的啊?
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 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='basin';
begin
ApppendToSysTemMenu(Form1,'-',78);
ApppendToSysTemMenu(Form1,'关于软件',79);
Application.OnMessage:=form1.Registermsg;
form1.Caption:=title1+'-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, 'httpServer', 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/basin/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;
sf.Terminate;
end;
end;
cache.UnlockList;
cache.Clear;
sleep(200);
end;

end.
 
不用了,我明白了!!!!!!
 

Similar threads

I
回复
0
查看
626
import
I
I
回复
0
查看
617
import
I
I
回复
0
查看
848
import
I
I
回复
0
查看
459
import
I
顶部