Delphi 编程技巧汇集

 （出处： www.delphibbs.com）

用程序模拟键盘和鼠标键盘

在Windows大 行其道的今天，windows界面程序受到广大用户的欢迎。对这些程序的操作不外乎两种，键盘输入控制和鼠标输入控制。有时，对于繁杂的，或重复性的操 作，我们能否通过编制程序来代替手工输入，而用程序来模拟键盘及鼠标的输入呢？答案是肯定的。这主要是通过两个API函数来实现的。 　　

　　下面以Delphi为例来介绍一下如何实现这两个功能。模拟键盘我们用Keybd_event这个api函数，模拟鼠标按键用mouse_event函数。大家不用担心，在delphi里调用api函数是很方便的事。 　　

　 　先介绍一下Keybd_event函数。Keybd_event能触发一个按键事件，也就是说回产生一个WM_KEYDOWN或WM_KEYUP消息。 当然也可以用产生这两个消息来模拟按键，但是没有直接用这个函数方便。Keybd_event共有四个参数，第一个为按键的虚拟键值，如回车键为 vk_return,　tab键为vk_tab。第二个参数为扫描码，一般不用设置，用0代替就行。第三个参数为选项标志，如果为keydown则置0即 可，如果为keyup则设成"KEYEVENTF_KEYUP"，第四个参数一般也是置0即可。用如下代码即可实现模拟按下i键，其中的$49表示i键的 虚拟键值：

keybd_event($49,0,0,0);
keybd_event($49,0,KEYEVENTF_KEYUP,0); ... 　　

　　

　　mouse_event最好 配合setcursorpos(x,y)函数一起使用，与Keybd_event类似，mouse_event有五个参数，第一个为选项标志，为 MOUSEEVENTF_LEFTDOWN时表示左键按下，为MOUSEEVENTF_LEFTUP表示左键松开，向系统发送相应消息。第二三个参数分别 表示x,y相对位置，一般可设为0,0,第四五个参数并不重要，一般也可设为0,0。若要得到Keybd_event和mouse_event函数的更详 细的用法，可以查阅msdn或delphi帮助。下面是关于mouse_event的示例代码：
　

 

在Windows大 行其道的今天，windows界面程序受到广大用户的欢迎。对这些程序的操作不外乎两种，键盘输入控制和鼠标输入控制。有时，对于繁杂的，或重复性的操 作，我们能否通过编制程序来代替手工输入，而用程序来模拟键盘及鼠标的输入呢？答案是肯定的。这主要是通过两个API函数来实现的。 　　

　　下面以Delphi为例来介绍一下如何实现这两个功能。模拟键盘我们用Keybd_event这个api函数，模拟鼠标按键用mouse_event函数。大家不用担心，在delphi里调用api函数是很方便的事。 　　

　 　先介绍一下Keybd_event函数。Keybd_event能触发一个按键事件，也就是说回产生一个WM_KEYDOWN或WM_KEYUP消息。 当然也可以用产生这两个消息来模拟按键，但是没有直接用这个函数方便。Keybd_event共有四个参数，第一个为按键的虚拟键值，如回车键为 vk_return,　tab键为vk_tab。第二个参数为扫描码，一般不用设置，用0代替就行。第三个参数为选项标志，如果为keydown则置0即 可，如果为keyup则设成"KEYEVENTF_KEYUP"，第四个参数一般也是置0即可。用如下代码即可实现模拟按下i键，其中的$49表示i键的 虚拟键值：

keybd_event($49,0,0,0);
keybd_event($49,0,KEYEVENTF_KEYUP,0); ... 　　

　　

　　mouse_event最好 配合setcursorpos(x,y)函数一起使用，与Keybd_event类似，mouse_event有五个参数，第一个为选项标志，为 MOUSEEVENTF_LEFTDOWN时表示左键按下，为MOUSEEVENTF_LEFTUP表示左键松开，向系统发送相应消息。第二三个参数分别 表示x,y相对位置，一般可设为0,0,第四五个参数并不重要，一般也可设为0,0。若要得到Keybd_event和mouse_event函数的更详 细的用法，可以查阅msdn或delphi帮助。下面是关于mouse_event的示例代码：
　

setcursorpos(20,132);
mouse_event(MOUSEEVENTF_LEFTDOWN,0,0,0,0);
mouse_event(MOUSEEVENTF_LEFTUP,0,0,0,0);
mouse_event(MOUSEEVENTF_LEFTDOWN,0,0,0,0);
mouse_event(MOUSEEVENTF_LEFTUP,0,0,0,0); ...

　　　上面的代码表示鼠标的双击，若要表示单击，用两个mouse_event即可(一次放下，一次松开)。 　
　　　注意，不管是模拟键盘还是鼠标事件，都要注意还原，即按完键要松开，一个keydown对应一个keyup；鼠标单击　完也要松开， 不然可能影响程序的功能。 　
　
　　　好了，希望本文能让你对模拟键盘和鼠标按键有个初步的了解，如果想更深入的了解其中的奥妙，可以查阅详实的msdn在线帮助，并多多动手实践。

 

（出处：http://blog.csdn.net/VBEND/）

- 作者： dragonvery 2005年03月24日, 星期四 14:35　 回复（2） |　 引用（0） 加入博采

编写后台监控软件

 后台监控软件，为了达到隐蔽监控的目的，应该满足正常运行时，不显示在任务栏上，在按Ctrl+Alt+Del出现的任务列表中也不显示，管理员可以通 过热键调出隐藏的运行界面。要作到这些，必须把当前进程变为一个系统服务，并且定义全局热键。
一、把当前进程变为一个系统服务:
目的是在任务列表中把程序隐藏起来。调用API函数RegisterServiceProcess实现。
二、定义全局热键（本例中定义热键Ctrl+Del+R），步骤：
1、定义捕获Windows消息WM_HOTKEY的钩子函数，即：
procedure WMHotKey(var Msg : TWMHotKey); message WM_HOTKEY;
2、向Windows加入一个全局原子 Myhotkey: GlobalAddAtom('MyHotkey'),
并保留其句柄。
3、向Windows登记热键：调用API函数RegisterHotKey实现。

  后台监控软件，为了达到隐蔽监控的目的，应该满足正常运行时，不显示在任务栏上，在按Ctrl+Alt+Del出现的任务列表中也不显示，管理员可以通过热键调出隐藏的运行界面。要作到这些，必须把当前进程变为一个系统服务，并且定义全局热键。
一、把当前进程变为一个系统服务:
目的是在任务列表中把程序隐藏起来。调用API函数RegisterServiceProcess实现。
二、定义全局热键（本例中定义热键Ctrl+Del+R），步骤：
1、定义捕获Windows消息WM_HOTKEY的钩子函数，即：
procedure WMHotKey(var Msg : TWMHotKey); message WM_HOTKEY;
2、向Windows加入一个全局原子 Myhotkey: GlobalAddAtom('MyHotkey'),
并保留其句柄。
3、向Windows登记热键：调用API函数RegisterHotKey实现。
三、源程序：



unit Unit1;
interface
uses
Windows, Messages, Forms, Dialogs, Classes, Controls, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{热键标识ID}
id: Integer;
procedure WMHotKey(var Msg : TWMHotKey); message WM_HOTKEY;
{ Privat-Declarations}
public
{ Public-Declarations}
end;
var
Form1 : TForm1;
implementation
const RSP_SIMPLE_SERVICE=1;
function RegisterServiceProcess (dwProcessID, dwType: DWord) : DWord; stdcall; external 'KERNEL32.DLL';
{$R *.DFM}

{捕获热键消息}
procedure TForm1.WMHotKey (var Msg : TWMHotKey);
begin
if msg.HotKey = id then
ShowMessage('Ctrl+Alt+R键被按下!');
form1.Visible :=true;
end;

procedure TForm1.FormCreate(Sender: TObject);
Const
{ALT、CTRL和R键的虚拟键值}
MOD_ALT = 1;
MOD_CONTROL = 2;
VK_R = 82;
begin
{首先判断程序是否已经运行}
if GlobalFindAtom('MyHotkey') = 0 then
begin
{注册全局热键Ctrl + Alt + R}
id:=GlobalAddAtom('MyHotkey');
RegisterHotKey(handle,id,MOD_CONTROL+MOD_Alt,VK_R);
end
else
halt;
end;

{把当前进程变为一个系统服务，从而在任务列表中把程序隐藏起来}
procedure TForm1.Button1Click(Sender: TObject);
begin
RegisterServiceProcess(GetCurrentProcessID,RSP_SIMPLE_SERVICE);
form1.Hide;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
close;
end;
{退出时释放全局热键}
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
UnRegisterHotKey(handle,id);
GlobalDeleteAtom(id);
end;
end.
四、说明：
在后台监控软件中使用以上功能，可真正实现隐蔽运行，热键调出，便于管理员进行管理。程序在Win98，Delphi5.0中运行通过。 

- 作者： dragonvery 2005年03月17日, 星期四 10:09　 回复（5） |　 引用（0） 加入博采

利用Hook技术实现键盘监控

    在许多系统中，出于安全或其它原因，常常要求随时对键盘进行监控，一个专业的监控程序必须具备两点，一是实时；二是作为指示图标运行。实际应用中把利用 Hook（即钩子）技术编写的应用程序添加到Windows的任务栏的指示区中就能够很好的达到这个目的。我在参考了API帮助文档基础上，根据在 Delphi开发环境中的具体实现分别对这两部分进行详细论述。
    一、Hook(钩子)的实现：Hook是应用程序在MicrosoftWindows消息处理过程中设置的用来监控消息流并且处理系统中尚未到达目的窗口 的某一类型消息过程的机制。如果Hook过程在应用程序中实现，若应用程序不是当前窗口时，该Hook就不起作用；如果Hook在DLL中实现，程序在运 行中动态调用它，它能实时对系统进行监控。根据需要，我们采用的是在DLL中实现Hook的方式。


    在许多系统中，出于安全或其它原因，常常要求随时对键盘进行监控，一个专业的监控程序必须具备两点，一是实时；二是作为指示图标运行。实际应用中把利用 Hook（即钩子）技术编写的应用程序添加到Windows的任务栏的指示区中就能够很好的达到这个目的。我在参考了API帮助文档基础上，根据在 Delphi开发环境中的具体实现分别对这两部分进行详细论述。
    一、Hook(钩子)的实现：Hook是应用程序在MicrosoftWindows消息处理过程中设置的用来监控消息流并且处理系统中尚未到达目的窗口 的某一类型消息过程的机制。如果Hook过程在应用程序中实现，若应用程序不是当前窗口时，该Hook就不起作用；如果Hook在DLL中实现，程序在运 行中动态调用它，它能实时对系统进行监控。根据需要，我们采用的是在DLL中实现Hook的方式。
   1．新建一个导出两个函数的DLL文件，在hookproc.pas中定义了钩子具体实现过程。代码如下：librarykeyspy;
useswindowsmessageshookprocin'hookproc.pas';
exportssetkeyhookendkeyhook;
beginnexthookproc:=0;
procsaveexit:=exitproc;
exitproc:=@keyhookexit;
end.
2.在Hookproc.pas中实现了钩子具体过程：unithookproc;
interfaceusesWindowsMessagesSysUtilsControlsStdCtrls;
varnexthookproc:hhook;
procsaveexit:pointer;
functionkeyboardhook(icode:integer;wparam:wparam;lparam:lparam):lresult;
stdcall;
export;
functionsetkeyhook:bool;export;//加载钩子functionendkeyhook:bool;export;//卸载钩子procedurekeyhookexit;
far;
constafilename='c:/debug.txt';//将键盘输入动作写入文件中vardebugfile:textfile;
implementationfunctionkeyboardhookhandler(icode:integer;wparam:wparam;lparam:lparam):lresult;
stdcall;
export;
beginificode<0thenbeginresult:=callnexthookex(hnexthookprocicodewparamlparam);
exit;
end;
assignfile(debugfileafilename);
append(debugfile);
ifgetkeystate(vk_return)<0thenbeginwriteln(debugfile'');
write(debugfilechar(wparam));
endelsewrite(debugfilechar(wparam));
closefile(debugfile);
result:=0;
end;
functionendkeyhook:bool;
export;
beginifnexthookproc<>0thenbeginunhookwindowshookex(nexthookproc);
nexthookproc:=0;
messagebeep(0);
end;
result:=hnexthookproc=0;
end;
procedurekeyhookexit;
far;
beginifnexthookproc<>0thenendkeyhook;
exitproc:=procsaveexit;
end;
end.
二、Win95/98使用任务栏右方指示区来显示应用程序或工具图标对指示区图标的操作涉及了一个API函数Shell_NotifyIcon，它有两个 参数，一个是指向TnotifyIconData结构的指针，另一个是要添加、删除、改动图标的标志。通过该函函数将应用程序的图标添加到指示区中，使其 作为图标运行增加专业特色。当程序起动后，用鼠标右键点击图标，则弹出一个菜单，可选择sethook或endhook。
unitkb;
interfaceusesWindowsMessagesSysUtilsClassesGraphicsControlsFormsDialogsStdCtrlsMenusshellapi;
consticon_id=1;
MI_iconevent=wm_user+1;//定义一个用户消息typeTForm1=class(TForm)
PopupMenu1:TPopupMenu;
sethook1:TMenuItem;
endhook1:TMenuItem;
N1:TMenuItem;
About1:TMenuItem;
Close1:TMenuItem;
Gettext1:TMenuItem;
procedureFormCreate(Sender:TObject);
proceduresethook1Click(Sender:TObject);
procedureendhook1Click(Sender:TObject);
procedureFormDestroy(Sender:TObject);
procedureClose1Click(Sender:TObject);
private{Privatedeclarations}
nid:tnotifyicondata;
normalicon:ticon;
public{Publicdeclarations}
procedureicontray(varmsg:tmessage);
messagemi_iconevent;
end;
varForm1:TForm1;
implementation{$R*.DFM}
functionsetkeyhook:bool;
external'keyspy.dll';
functionendkeyhook:bool;
external'keyspy.dll';
proceduretform1.icontray(varmsg:tmessage);
varpt:tpoint;
beginifmsg.lparam=wm_lbuttondownthensethook1click(self);
ifmsg.LParam=wm_rbuttondownthenbegingetcursorpos(pt);
setforegroundwindow(handle);
popupmenu1.popup(pt.xpt.y);
end;
end;
procedureTForm1.FormCreate(Sender:TObject);
beginnormalicon:=ticon.create;
application.title:=caption;
nid.cbsize:=sizeof(nid);
nid.wnd:=handle;
nid.uid:=icon_id;
nid.uflags:=nif_iconornif_messageornif_tip;
nid.ucallbackmessage:=mi_iconevent;
nid.hIcon:=normalicon.handle;
strcopy(nid.sztippchar(caption));
nid.uFlags:=nif_messageornif_iconornif_tip;shell_notifyicon(nim_add@nid);
SetWindowLong(Application.HandleGWL_EXSTYLEWS_EX_TOOLWINDOW);
end;
procedureTForm1.sethook1Click(Sender:TObject);
beginsetkeyhook;
end;
procedureTForm1.endhook1Click(Sender:TObject);
beginendkeyhook;
end;
procedureTForm1.FormDestroy(Sender:TObject);
beginnid.uFlags:=0;
shell_notifyicon(nim_delete@nid);
end;
procedureTForm1.Close1Click(Sender:TObject);
beginapplication.terminate;
end;
该程序虽然只用了几个shellai函数，但是它涉及到了在Delphi中对DLL的引用、钩子实现、对指示区的操作、用户定义消息的处理、文件的读写等比较重要的内容，我相信这篇文章能对许多Delphi的初学者有所帮助。
该程序在Win98、Delphi4.0中正常运行。

- 作者： dragonvery 2005年03月17日, 星期四 10:06　 回复（1） |　 引用（0） 加入博采

建立应用软件注册安全机制

软件的安全性是个永恒的话题，一直困扰着人们，程序员们常常因此熬夜。Novell 公司的网络操作系统NetWare
以其完善可靠的安全管理机制著称，为实现用户登录的安全性和防止非法入侵者闯入，系统提供了几种有效的限制措施和检测功能。本文讨论如何建立完善的软件注
册安全机制，有效地管理用户登录，为应用软件提供可靠的保护，并在Delphi下实现。
软件的安全性是个永恒的话题，一直困扰着人们，程序员们常常因此熬夜。Novell 公司的网络操作系统NetWare 以其完善可靠的安全管理机制著称，为实现用户登录的安全性和防止非法入侵者闯入，系统提供了几种有效的限制措施和检测功能。本文讨论如何建立完善的软件注 册安全机制，有效地管理用户登录，为应用软件提供可靠的保护，并在Delphi下实现。

　 　Delphi 作为一个优秀的编程工具，功能极其强大，令开发周期大大缩短，生成的代码运行速度快，使得Windows 软件设计成为一种乐趣。基本思路是：建立Paradox 格式的用户帐户表Users.DB，并加密保护，由管理员维护。预先在此表中登记并有注册权限的用户，可持本人有效口令登录进入系统。

　　实现步骤如下：

　　1 ．在应用软件主目录（假设为C:/Register）下创建两个子目录，分别命名为Login 和Data。

　 　2 ．从Delphi 的Tools 菜单中启动Database Desktop，并选择Tools/AliasManager ...创建一个新别名。方法是：在Alias Manager 对话框中点New，给出新别名UserInfo，并指向C:/Register/Data 目录，按Keep New、OK 等按钮保存新别名。

　　3 ．利用Database Desktop 创建Paradox 5.0 for Windows 数据表Users.DB，结构见表1。事实上，对于商业软件还需要更多的域。

表1 表Users.DB 的结构
域名类型大小关键字说明
Name A 16 * 用户名
Password A 16 * 注册口令
Fullname A 32 用户全名
Group I 用户组号
Enabled L 注册允许

　 　4 ．设定Name, Group 和Enabled 为非空域(Required Field)，Group 的最小值为0，最大值为3，默认值为3，Enabled 的默认值为True。用户组0 为系统管理员，可进行几乎任何操作；用户组1 为软件操作人员，可进行除用户帐户管理以外的操作，包括建立和删除数据；用户组2 为普通用户，可使用系统资源，无修改权限，而用户组3 仅可浏览系统有限信息。

　　5 ．用口令"UserPassword" 保护Users.DB 表, 存于Data 目录下。利用Database Desktop 向表中输入若干样本用户（见表2），然后关闭DatabaseDesktop。

表2 表Users.DB 的样本用户
Name Password Fullname Group Enabled
Supervisor AAAAAA Super User 0 True
Director BBBBBB Director User 1 True
Guest 3 True
User1 CCCCCC General User1 1 False
User1 DDDDDD General User1 2 True
User2 EEEEEE General User2 3 True

　　表2 显示，允许同一用户以不同身份（用户组）登录进入系统，享有不同的权限。如用户User1，以不同密码登记，分属用户组1 和2。

　 　6 ．返回Delphi IDE，新建项目Register.dpr 并存入C:/Register 目录，主窗体单元命名为Main.pas。用户注册成功后，方能启动主窗体进入系统。本系统仅显示用户信息及登录的日期和时间以表示注册成功（见图5）， 并不做其它任何事情，这里便是读者应用系统的接口。为此，在主窗体上放入一个TGroupBox 组件，TLabel 和TEdit 组件各五个。将所有TEdit 的Text 属性清空，ReadOnly 属性值设为True，窗体和组件其余属性按表3 设置。

　　7 ．创建主窗体的OnActivate 事件处理程序，登录成功并激活主窗体时执行，显示用户信息、登录日期和时间。过程如下：

procedure TMainForm.FormActivate(Sender: TObject);
begin
if Time< =StrToTime('12:00:00') then
Caption:=' 上午好，您已成功登录！'
else
Caption:=' 下午好，您已成功登录！';
// 显示登录用户信息、登录日期和时间
NameEdit.Text:=LoginUser.UserName;
FullNameEdit.Text:=LoginUser.UserFullName;
GroupEdit.Text:=IntToStr(LoginUser.UserGroup);
DisplayDateEdit.Text:=DateToStr(Date);
DisplayTimeEdit.Text:=TimeToStr(Time);
end;

表3 主窗体中组件属性设置
组件属性设置
Form1 Caption
Name MainForm
Position poScreenCenter
GroupBox1 Caption 用户信息
Label1 Caption 用户名称：
Label2 Caption 用户全名：
Label3 Caption 用户组号：
Label4 Caption 登录日期：
Label5 Caption 登录时间：
Edit1 Name NameEdit
Edit2 Name FullnameEdit
Edit3 Name GroupEdit
Edit4 Name DisplayDateEdit
Edit5 Name DisplayTimeEdit
　　8 ．数据模板。选择File/New Data Module 建立数据模板LogDataModule，放入一个Ttable 组件，如图1。属性按表4 设置，命名其单元为MD.pas，存入Login 目录。

表4 数据模板中组件属性设置
组件属性设置
Table1 DatabaseName UserInfo
Name UsersTable
TableName Users.DB
　　9 ．创建注册窗体。选择File/New Form 创建一个新窗体，并加入组件TLabel、TEdit 和TbitBtn 各两个。窗体和组件属性按表5 设置，命名其单元为Login.pas，存于Login 目录。

表5 注册窗体中组件属性设置
组件属性设置
Form2 ActiveControl UserNameEdit
Caption 请注册
Name LoginDialogForm
Position poScreenCenter
Label1 Caption 用户：
Label2 Caption 密码：
Edit1 Name LoginNameEdit
Text
Edit2 Name PasswordEdit
PasswordChar *
Text
BitBtn1 Caption 注册(&L)
Enabled False
Kind bkOK
Name LoginBitBtn
BitBtn2 Caption 取消(&C)
Enabled True
Kind bkCancel
Name CancelBitBtn

　　10 ．选择File/New 命令，从New Items 的New 页中选择Unit 项建一个无窗体单元Addition.pas 存入Login 目录，在其interface 段输入下列语句：

uses Classes, Forms, Sysutils;
type
TApplicationUser=class(TComponent)
private
FUserName: string;
FFullName: string;
FUserGroup: Integer;
public
property UserName: string read
FUserName write FUserName;
property UserFullName: string read
FFullName write FFullName;
property UserGroup: Integer read
FUserGroup write FUserGroup;
end;
var
LoginUser: TApplicationUser;
　　在implementation 段加入下列语句：

initialization
LoginUser:=TapplicationUser.Create(Application);
　　11 ．创建注册窗体(LoginDialogForm) 的OnCreate 事件处理程序。在
private 段中声明CountDown 为Integer 变量，作为计数器，并将下述语句
插入begin 与end 之间：

CountDown:=3; // 允许尝试注册3 次

　　12 ．建立用户名输入框(LoginNameEdit) 的OnChange 事件处理程序，使窗体LoginDialogForm 创建时注册按钮为灰色，用户输入登录名后才可用。不难实现，源代码略。

　　13 ．创建注册过程。双击注册按钮(LoginBitBtn)，在begin 和end 之间输入其OnClick 事件处理程序代码：

ModalResult:=mrNone;
try
Session.AddPassword('UserPassword');
LogDataModule.UsersTable.Open;
//注册信息处理
if not LogDataModule.UsersTable.FindKey
([LoginNameEdit.Text,PasswordEdit.Text]) then
begin
//处理注册次数
dec(CountDown);
if CountDown< =0 then ModalResult:=mrCancel else
begin
　MessageBeep($FFFF);
　Application.MessageBox('请您重试一次!',
　'无效注册信息',mb_iconstop+mb_OK);
　//重设输入焦点
　LoginNameEdit.SetFocus;
end;
　exit;
end;
//检查注册允许值
if not LogDataModule.UsersTable.FieldByName
('Enabled').AsBoolean then
begin
　MessageBeep($FFFF);
　Application.MessageBox( '抱歉，您不能进入系统！',
　'使用权限终止',mb_iconexclamation+mb_OK);
　ModalResult:=mrCancel;
　exit;
end;
//获取注册用户信息
with LogDataModule do
begin
　LoginUser.UserName：=UsersTable.FieldByName（'Name'）。AsString；
　LoginUser.UserFullName:=UsersTable.FieldByName('Fullname').AsString;
　LoginUser.UserGroup:=UsersTable.FieldByName('Group').AsInteger;
End;
ModalResult:=mrOK;
//关闭表，清除密码
finally
LogDataModule.UsersTable.Close;
Session.RemovePassword('UserPassword');
end;
　　14 ．在Main.pas 单元的uses 中加入"Addition"，在Login.pas 单元的implementation 段增加uses 语句：

uses
MD, Addition;

　　15 ．打开过程文件Register.dpr，在uses 语句中加入"Controls"，将"Application.run;" 改为下列语句，只有注册成功时才启动系统，同时释放注册窗体, 以确保安全和减少内存占用。

if LoginDialogForm.ShowModal=mrOK then
begin
LoginDialogForm.Free;
Application.Run;
end;

　　16 ．编译、运行。注册窗口见图2，输入用户名和密码后点" 注册" 按钮。

　　如果注册信息有误，系统出现提示框，允许重新注册，见图3。若三次尝试均不成功，注册窗口将保护性关闭。

　　访问权已被管理员终止的用户（Enabled 的值为False），例如用户User1 以口令CCCCCC 注册至用户组1，系统拒绝进入，见图4。

　　注册成功后将启动系统主程序。例如用户Supervisor 以口令AAAAAA 注册，见图5。

　　上述方案具有以下特点：

　　1 ．Supervisor 用户具有至高无上的权利，由系统创建，不能删除，仅Password 和Fullname 字段的值允许自行修改。主要负责系统维护和用户帐户管理等工作，是系统的永久性特权用户。

　 　2 ．确保用户帐户表Users.DB 的安全致关重要，本方案采用了较为可靠的关键性技术，就是注册过程（见步骤13）中"try ...finally ...end"结构的应用。仅当用户按下" 注册" 按钮时，注册模块转送表Users.DB 的密码并将其打开，以处理注册信息。而无论成功与否，在finally 部分都能及时关闭表Users.DB，并立即清除内存中的密码。

　　3 ．用户帐户管理模块设在主程序中，完成表Users.DB 的维护功能，包括建立用户帐户和用户组，增、删用户，分配访问权限等。只有Supervisor 或其授权用户才可进入。

　　4 ．组帐户管理：用户按不同级别分组，再按组进行权限分配，以简化管理。如系统可根据登录用户所属的用户组，十分方便地屏蔽相应菜单项，以达到限制用户使用权限的目的。对用户群大的系统，此项技术的优越性尤为显著。

　　5 ．默认帐户限制：建立用户帐户时，系统默认其Group=3，仅具备浏览有限信息之权限，不致因管理员一时疏忽使新建用户越权使用，危及系统安全。

　　6 ．单独帐户限制：用户注册时，必须提供完整的个人有效信息才能进入系统。

　　7 ．注册允许限制：管理员可随时取消或恢复单个用户、用户组甚至系统所有用户（Supervisor 除外）的注册权限，只需设置注册允许字段Enabled 的值为False 或True。

　　8 ．非法入侵限制：三次注册尝试不成功便保护性关闭注册窗口，以防非法非法入侵者无限制尝试。

　　本文介绍了应用软件注册安全性问题的综合解决方案，容易实现，便于扩充-- 如增加注册时间限制和记帐收费功能等，可建立较完善的注册安全机制，适合大型商用软件开发。

（出处：www）

- 作者： dragonvery 2005年03月16日, 星期三 10:12　 回复（0） |　 引用（0） 加入博采

基本算法（用 PASCAL 描述）

1.数论算法
求两数的最大公约数
function gcd(a,b:integer):integer;
begin
if b=0 then gcd:=a
else gcd:=gcd (b,a mod B);
end;

）

1.数论算法
求两数的最大公约数
function gcd(a,b:integer):integer;
begin
if b=0 then gcd:=a
else gcd:=gcd (b,a mod B);
end;

求两数的最小公倍数
function lcm(a,b:integer):integer;
begin
if a< b then swap(a,B);
lcm:=a;
while lcm mod b >0 do inc(lcm,a);
end;

素数的求法
A.小范围内判断一个数是否为质数：
function prime (n: integer): Boolean;
var I: integer;
begin
for I:=2 to trunc(sqrt(n)) do
if n mod I=0 then begin
prime:=false; exit;
end;
prime:=true;
end;

B.判断longint范围内的数是否为素数（包含求50000以内的素数表）：
procedure getprime;
var
i,j:longint;
p:array[1..50000] of boolean;
begin
fillchar(p,sizeof(p),true);
p[1]:=false;
i:=2;
while i< 50000 do begin
if p[i] then begin
j:=i*2;
while j< 50000 do begin
p[j]:=false;
inc(j,i);
end;
end;
inc(i);
end;
l:=0;
for i:=1 to 50000 do
if p[i] then begin
inc(l);pr[l]:=i;
end;
end;{getprime}

function prime(x:longint):integer;
var i:integer;
begin
prime:=false;
for i:=1 to l do
if pr[i] >=x then break
else if x mod pr[i]=0 then exit;
prime:=true;
end;{prime}

2．

3．


4.求最小生成树
A.Prim算法：
procedure prim(v0:integer);
var
lowcost,closest:array[1..maxn] of integer;
i,j,k,min:integer;
begin
for i:=1 to n do begin
lowcost[i]:=cost[v0,i];
closest[i]:=v0;
end;
for i:=1 to n-1 do begin
{寻找离生成树最近的未加入顶点k}
min:=maxlongint;
for j:=1 to n do
if (lowcost[j]< min) and (lowcost[j]< >0) then begin
min:=lowcost[j];
k:=j;
end;
lowcost[k]:=0; {将顶点k加入生成树}
{生成树中增加一条新的边k到closest[k]}
{修正各点的lowcost和closest值}
for j:=1 to n do
if cost[k,j]< lwocost[j] then begin
lowcost[j]:=cost[k,j];
closest[j]:=k;
end;
end;
end;{prim}

B.Kruskal算法：(贪心)
按权值递增顺序删去图中的边，若不形成回路则将此边加入最小生成树。
function find(v:integer):integer; {返回顶点v所在的集合}
var i:integer;
begin
i:=1;
while (i< =n) and (not v in vset[i]) do inc(i);
if i< =n then find:=i else find:=0;
end;

procedure kruskal;
var
tot,i,j:integer;
begin
for i:=1 to n do vset[i]:=[i];{初始化定义n个集合，第I个集合包含一个元素I}
p:=n-1; q:=1; tot:=0; {p为尚待加入的边数，q为边集指针}
sort;
{对所有边按权值递增排序，存于e[I]中，e[I].v1与e[I].v2为边I所连接的两个顶点的序号，e[I].len为第I条边的长度}
while p >0 do begin
i:=find(e[q].v1);j:=find(e[q].v2);
if i< >j then begin
inc(tot,e[q].len);
vset[i]:=vset[i]+vset[j];vset[j]:=[];
dec(p);
end;
inc(q);
end;
writeln(tot);
end;


5.最短路径
A.标号法求解单源点最短路径：
var
a:array[1..maxn,1..maxn] of integer;
b:array[1..maxn] of integer; {b[i]指顶点i到源点的最短路径}
mark:array[1..maxn] of boolean;

procedure bhf;
var
best,best_j:integer;
begin
fillchar(mark,sizeof(mark),false);
mark[1]:=true; b[1]:=0;{1为源点}
repeat
best:=0;
for i:=1 to n do
If mark[i] then {对每一个已计算出最短路径的点}
for j:=1 to n do
if (not mark[j]) and (a[i,j] >0) then
if (best=0) or (b[i]+a[i,j]< best) then begin
best:=b[i]+a[i,j]; best_j:=j;
end;
if best >0 then begin
b[best_j]:=best；mark[best_j]:=true;
end;
until best=0;
end;{bhf}

B.Floyed算法求解所有顶点对之间的最短路径：
procedure floyed;
begin
for I:=1 to n do
for j:=1 to n do
if a[I,j] >0 then p[I,j]:=I else p[I,j]:=0; {p[I,j]表示I到j的最短路径上j的前驱结点}
for k:=1 to n do {枚举中间结点}
for i:=1 to n do
for j:=1 to n do
if a[i,k]+a[j,k]< a[i,j] then begin
a[i,j]:=a[i,k]+a[k,j];
p[I,j]:=p[k,j];
end;
end;

C. Dijkstra 算法：
类似标号法，本质为贪心算法。
var
a:array[1..maxn,1..maxn] of integer;
b,pre:array[1..maxn] of integer; {pre[i]指最短路径上I的前驱结点}
mark:array[1..maxn] of boolean;
procedure dijkstra(v0:integer);
begin
fillchar(mark,sizeof(mark),false);
for i:=1 to n do begin
d[i]:=a[v0,i];
if d[i]< >0 then pre[i]:=v0 else pre[i]:=0;
end;
mark[v0]:=true;
repeat {每循环一次加入一个离1集合最近的结点并调整其他结点的参数}
min:=maxint; u:=0; {u记录离1集合最近的结点}
for i:=1 to n do
if (not mark[i]) and (d[i]< min) then begin
u:=i; min:=d[i];
end;
if u< >0 then begin
mark[u]:=true;
for i:=1 to n do
if (not mark[i]) and (a[u,i]+d[u]< d[i]) then begin
d[i]:=a[u,i]+d[u];
pre[i]:=u;
end;
end;
until u=0;
end;

D.计算图的传递闭包
Procedure Longlink;
Var
T:array[1..maxn,1..maxn] of boolean;
Begin
Fillchar(t,sizeof(t),false);
For k:=1 to n do
For I:=1 to n do
For j:=1 to n do T[I,j]:=t[I,j] or (t[I,k] and t[k,j]);
End;


6.0-1背包问题（部分背包问题可有贪心法求解：计算Pi/Wi)
数据结构：
w[i]:第i个背包的重量；
p[i]:第i个背包的价值；
(1)0-1背包： 每个背包只能使用一次或有限次(可转化为一次)：
A.求最多可放入的重量。
NOIP2001 装箱问题
有一个箱子容量为v(正整数，o≤v≤20000)，同时有n个物品(o≤n≤30)，每个物品有一个体积 (正整数)。要求从 n 个物品中，任取若千个装入箱内，使箱子的剩余空间为最小。
l 搜索方法
procedure search(k,v:integer); {搜索第k个物品，剩余空间为v}
var i,j:integer;
begin
if v< best then best:=v;
if v-(s[n]-s[k-1]) >=best then exit; {s[n]为前n个物品的重量和}
if k< =n then begin
if v >w[k] then search(k+1,v-w[k]);
search(k+1,v);
end;
end;

l DP
F[I,j]为前i个物品中选择若干个放入使其体积正好为j的标志，为布尔型。
实现:将最优化问题转化为判定性问题
F[I,j]=f[i-1,j-w[i]] (w[I]< =j< =v) 边界：f[0,0]:=true.
For I:=1 to n do
For j:=w[I] to v do F[I,j]:=f[I-1,j-w[I]];
优化：当前状态只与前一阶段状态有关，可降至一维。
F[0]:=true;
For I:=1 to n do begin
F1:=f;
For j:=w[I] to v do
If f[j-w[I]] then f1[j]:=true;
F:=f1;
End;

B.求可以放入的最大价值。
F[I,j]=


C.求恰好装满的情况数。

　

(2)每个背包可使用任意次：
A.求最多可放入的重量。
状态转移方程为
f[I,j]=max{f[i-w[j]

　


B.求可以放入的最大价值。
USACO 1.2 Score Inflation
进行一次竞赛，总时间T固定，有若干种可选择的题目，每种题目可选入的数量不限，每种题目有一个ti（解答此题所需的时间）和一个si（解答此题所得的分数），现要选择若干题目，使解这些题的总时间在T以内的前提下，所得的总分最大，求最大的得分。
*易想到：
f[i,j] = max { f [i- k*w[j], j-1] + k*v[j] } (0< =k< = i div w[j])
其中f[i,j]表示容量为i时取前j种背包所能达到的最大值。
*优化：
Begin
FillChar(problem,SizeOf(problem),0);
Assign(Input,'inflate.in');
Reset(Input);
Readln(M,N);
For i:=1 To N Do
With problem[i] Do
Readln(point,time);
Close(Input);

FillChar(f,SizeOf(f),0);
For i:=1 To M Do
For j:=1 To N Do
If i-problem[j].time >=0 Then
Begin
t:=problem[j].point+f[i-problem[j].time];
If t >f[i] Then f[i]:=t;
End;

Assign(Output,'inflate.out');
Rewrite(Output);
Writeln(f[M]);
Close(Output);
End.
C.求恰好装满的情况数。
Ahoi2001 Problem2
求自然数n本质不同的质数和的表达式的数目。
思路一，生成每个质数的系数的排列，在一一测试，这是通法。
procedure try(dep:integer);
var i,j:integer;
begin
cal; {此过程计算当前系数的计算结果，now为结果}
if now >n then exit; {剪枝}
if dep=l+1 then begin {生成所有系数}
cal;
if now=n then inc(tot);
exit;
end;
for i:=0 to n div pr[dep] do begin
xs[dep]:=i;
try(dep+1);
xs[dep]:=0;
end;
end;

思路二，递归搜索效率较高
procedure try(dep,rest:integer);
var i,j,x:integer;
begin
if (rest< =0) or (dep=l+1) then begin
if rest=0 then inc(tot);
exit;
end;
for i:=0 to rest div pr[dep] do
try(dep+1,rest-pr[dep]*i);
end;

思路三：可使用动态规划求解
USACO1.2 money system
V个物品，背包容量为n，求放法总数。
转移方程：

Procedure update;
var j,k:integer;
begin
c:=a;
for j:=0 to n do
if a[j] >0 then
for k:=1 to n div now do
if j+now*k< =n then inc(c[j+now*k],a[j]);
a:=c;
end;
{main}
begin
read(now); {读入第一个物品的重量}
i:=0; {a[i]为背包容量为i时的放法总数}
while i< =n do begin
a[i]:=1; inc(i,now); end; {定义第一个物品重的整数倍的重量a值为1，作为初值}
for i:=2 to v do
begin
read(now);
update; {动态更新}
end;
writeln(a[n]);

7.排序算法
A.快速排序：
procedure sort(l,r:integer);
var i,j,mid:integer;
begin
i:=l;j:=r; mid:=a[(l+r) div 2]; {将当前序列在中间位置的数定义为中间数}
repeat
while a[i]< mid do inc(i); {在左半部分寻找比中间数大的数}
while mid< a[j] do dec(j);{在右半部分寻找比中间数小的数}
if i< =j then begin {若找到一组与排序目标不一致的数对则交换它们}
swap(a[i],a[j]);
inc(i);dec(j); {继续找}
end;
until i >j;
if l< j then sort(l,j); {若未到两个数的边界，则递归搜索左右区间}
if i< r then sort(i,r);
end;{sort}
　

B.插入排序：
procedure insert_sort(k,m:word); {k为当前要插入的数，m为插入位置的指针}
var i:word; p:0..1;
begin
p:=0;
for i:=m downto 1 do
if k=a[i] then exit;
repeat
If k >a[m] then begin
a[m+1]:=k; p:=1;
end
else begin
a[m+1]:=a[m]; dec(m);
end;
until p=1;
end;{insert_sort}
l 主程序中为：
a[0]:=0;
for I:=1 to n do insert_sort(b[I],I-1);

C.选择排序：
procedure sort;
var i,j,k:integer;
begin
for i:=1 to n-1 do begin
k:=i;
for j:=i+1 to n do
if a[j]< a[k] then k:=j; {找出a[I]..a[n]中最小的数与a[I]作交换}
if k< >i then begin
a[0]:=a[k];a[k]:=a[i];a[i]:=a[0];
end;
end;
end;

D. 冒泡排序
procedure sort;
var i,j,k:integer;
begin
for i:=n downto 1 do
for j:=1 to i-1 do
if a[j] >a[i] then begin
a[0]:=a[i];a[i]:=a[j];a[j]:=a[0];
end;
end;

E.堆排序：
procedure sift(i,m:integer);{调整以i为根的子树成为堆,m为结点总数}
var k:integer;
begin
a[0]:=a[i]; k:=2*i;{在完全二叉树中结点i的左孩子为2*i,右孩子为2*i+1}
while k< =m do begin
if (k< m) and (a[k]< a[k+1]) then inc(k);{找出a[k]与a[k+1]中较大值}
if a[0]< a[k] then begin a[i]:=a[k];i:=k;k:=2*i; end
else k:=m+1;
end;
a[i]:=a[0]; {将根放在合适的位置}
end;

procedure heapsort;
var
j:integer;
begin
for j:=n div 2 downto 1 do sift(j,n);
for j:=n downto 2 do begin
swap(a[1],a[j]);
sift(1,j-1);
end;
end;

F. 归并排序
{a为序列表，tmp为辅助数组}
procedure merge(var a:listtype; p,q,r:integer);
{将已排序好的子序列a[p..q]与a[q+1..r]合并为有序的tmp[p..r]}
var I,j,t:integer;
tmp:listtype;
begin
t:=p;i:=p;j:=q+1;{t为tmp指针，I,j分别为左右子序列的指针}
while (t< =r) do begin
if (i< =q){左序列有剩余} and ((j >r) or (a[i]< =a[j])) {满足取左边序列当前元素的要求}
then begin
tmp[t]:=a[i]; inc(i);
end
else begin
tmp[t]:=a[j];inc(j);
end;
inc(t);
end;
for i:=p to r do a[i]:=tmp[i];
end;{merge}

procedure merge_sort(var a:listtype; p,r: integer); {合并排序a[p..r]}
var q:integer;
begin
if p< >r then begin
q:=(p+r-1) div 2;
merge_sort (a,p,q);
merge_sort (a,q+1,r);
merge (a,p,q,r);
end;
end;
{main}
begin
merge_sort(a,1,n);
end.


G.基数排序
思想：对每个元素按从低位到高位对每一位进行一次排序


8.高精度计算
A.
B.
C.
D.

9.树的遍历顺序转换
A. 已知前序中序求后序
procedure Solve(pre,mid:string);
var i:integer;
begin
if (pre='') or (mid='') then exit;
i:=pos(pre[1],mid);
solve(copy(pre,2,i),copy(mid,1,i-1));
solve(copy(pre,i+1,length(pre)-i),copy(mid,i+1,length(mid)-i));
post:=post+pre[1]; {加上根，递归结束后post即为后序遍历}
end;

B.已知中序后序求前序
procedure Solve(mid,post:string);
var i:integer;
begin
if (mid='') or (post='') then exit;
i:=pos(post[length(post)],mid);
pre:=pre+post[length(post)]; {加上根，递归结束后pre即为前序遍历}
solve(copy(mid,1,I-1),copy(post,1,I-1));
solve(copy(mid,I+1,length(mid)-I),copy(post,I,length(post)-i));
end;

C.已知前序后序求中序

function ok(s1,s2:string):boolean;
var i,l:integer; p:boolean;
begin
ok:=true;
l:=length(s1);
for i:=1 to l do begin
p:=false;
for j:=1 to l do
if s1[i]=s2[j] then p:=true;
if not p then begin ok:=false;exit;end;
end;
end;

procedure solve(pre,post:string);
var i:integer;
begin
if (pre='') or (post='') then exit;
i:=0;
repeat
inc(i);
until ok(copy(pre,2,i),copy(post,1,i));
solve(copy(pre,2,i),copy(post,1,i));
midstr:=midstr+pre[1];
solve(copy(pre,i+2,length(pre)-i-1),copy(post,i+1,length(post)-i-1));
end;

10.求图的弱连通子图(DFS)
procedure dfs ( now,color: integer);
begin
for i:=1 to n do
if a[now,i] and c[i]=0 then begin
c[i]:=color;
dfs(I,color);
end;
end;


11.拓扑排序
寻找一数列，其中任意连续p项之和为正，任意q 项之和为负，若不存在则输出NO.


12.进制转换
A.整数任意正整数进制间的互化

NOIP1996数制转换
设字符串A$的结构为: A$='mp'
其中m为数字串(长度< =20),而n,p均为1或2位的数字串(其中所表达的内容在2-10之间)
程序要求:从键盘上读入A$后(不用正确性检查),将A$中的数字串m(n进制)以p进制的形式输出.
例如:A$='48< 10 >8'
其意义为:将10进制数48,转换为8进制数输出.
输出结果:48< 10 >=60< 8 >

B.实数任意正整数进制间的互化
C.负数进制：
NOIP2000
设计一个程序，读入一个十进制数的基数和一个负进制数的基数，并将此十进制数转换为此负 进制下的数：-R∈{-2，-3，-4,....-20}

13.全排列与组合的生成
排列的生成：（1..n）
procedure solve(dep:integer);
var
i:integer;
begin
if dep=n+1 then begin writeln(s);exit; end;
for i:=1 to n do
if not used[i] then begin
s:=s+chr(i+ord('0'));used[i]:=true;
solve(dep+1);
s:=copy(s,1,length(s)-1); used[i]:=false;
end;
end;
组合的生成(1..n中选取k个数的所有方案)
procedure solve(dep,pre:integer);
var
i:integer;
begin
if dep=k+1 then begin writeln(s);exit; end;
for i:=1 to n do
if (not used[i]) and (i >pre) then begin
s:=s+chr(i+ord('0'));used[i]:=true;
solve(dep+1,i);
s:=copy(s,1,length(s)-1); used[i]:=false;
end;
end;

　

14 递推关系
计算字串序号模型
USACO1.2.5 StringSobits
长度为N (N< =31)的01串中1的个数小于等于L的串组成的集合中找出按大小排序后的第I个01串。


数字划分模型
*NOIP2001数的划分
将整数n分成k份，且每份不能为空，任意两种分法不能相同(不考虑顺序)。
d[0,0]:=1;
for p:=1 to n do
for i:=p to n do
for j:=k downto 1 do inc(d[i,j],d[i-p,j-1]);
writeln(d[n,k]);

*变形1：考虑顺序
d[ i, j] : = d [ i-k, j-1] (k=1..i)
*变形2：若分解出来的每个数均有一个上限m
d[ i, j] : = d [ i-k, j-1] (k=1..m)


15.算符优先法求解表达式求值问题
const maxn=50;
var
s1:array[1..maxn] of integer; {s1为数字栈}
s2:array[1..maxn] of char; {s2为算符栈}
t1,t2:integer; {栈顶指针}

procedure calcu;
var
x1,x2,x:integer;
p:char;
begin
p:=s2[t2]; dec(t2);
x2:=s1[t1]; dec(t1);
x1:=s1[t1]; dec(t1);
case p of
'+':x:=x1+x2;
'-':x:=x1-x2;
'*':x:=x1*x2;
'/':x:=x1 div 2;
end;
inc(t1);s1[t1]:=x;
end;

procedure work;
var c:char;v:integer;
begin
t1:=0;t2:=0;
read©;
while c< >';' do
case c of
'+','-': begin
while (t2 >0) and (s2[t2]< >'(') do calcu;
inc(t2);s2[t2]:=c;
read©;
end ;
'*','/':begin
if (t2 >0) and ((s2[t2]='*') or (s2[t2]='/')) then calcu;
inc(t2);s2[t2]:=c;
read©;
end;
'(':begin inc(t2); s2[t2]:=c; read©; end;
')':begin
while s2[t2]< >'(' do calcu;
dec(t2); read©;
end;
'0'..'9':begin
v:=0;
repeat
v:=10*v+ord©-ord('0');
read©;
until (c< '0') or (c >'9');
inc(t1); s1[t1]:=v;
end;
end;
while t2 >0 do calcu;
writeln(s1[t1]);
end;

16.查找算法
折半查找
function binsearch(k:keytype):integer;
var low,hig,mid:integer;
begin
low:=1;hig:=n;
mid:=(low+hig) div 2;
while (a[mid].key< >k) and (low< =hig) do begin
if a[mid].key >k then hig:=mid-1
else low:=mid+1;
mid:=(low+hig) div 2;
end;
if low >hig then mid:=0;
binsearch:=mid;
end;
树形查找
二叉排序树：每个结点的值都大于其左子树任一结点的值而小于其右子树任一结点的值。
查找
function treesrh(k:keytype):pointer;
var q:pointer;
begin
q:=root;
while (q< >nil) and (q^.key< >k) do
if k< q^.key then q:=q^.left
else q:=q^.right;
treesrh:=q;
end;


17．KMP算法

18．贪心
*会议问题
（1） n个活动每个活动有一个开始时间和一个结束时间，任一时刻仅一项活动进行，求满足活动数最多的情况。
解：按每项活动的结束时间进行排序，排在前面的优先满足。

（2）会议室空闲时间最少。

（3）每个客户有一个愿付的租金，求最大利润。

（4）共R间会议室，第i个客户需使用i间会议室，费用相同，求最大利润。

附录1 常用技巧
1.带权中位数
我国蒙古大草原上有N（N是不大于100的自然数）个牧民定居点P1（X1，Y1）、P2（X2，Y2）、 ...Pn（Xn，Yn），相应地有关权重为Wi，现在要求你在大草原上找一点P（Xp，Yp），使P点到任 一点Pi的距离Di与Wi之积之和为最小。 　　
　　 即求 D=W1*D1+W2*D2+...+Wi*Di+...+Wn*Dn 有最小值 　　
结论：对x与y两个方向分别求解带权中位数，转化为一维。
设最佳点p为点k，则点k满足：
令W为点k到其余各点的带权距离之和，则
sigema( i=1 to k-1) Wi*Di < = W/2
sigema( i=k+1 to n) Wi*Di < = W/2
同时满足上述两式的点k即为带权中位数。

2．求一序列中连续子序列的最大和
begin
maxsum:=-maxlongint;
sum:=0;
for i:=1 to n do begin
inc(sum,data[i]);
if sum >maxsum then maxsum:=sum;
if sum< 0 then sum:=0;
end;
writeln(maxsum);
end;

（出处：www.delphibbs.com）