用Delphi制作DLL
- 博客频道 - CSDN.NET
分类：Delphi
一、开使你的第一个DLL专案 　　1.File-&Close all-&File-&New﹝DLL﹞代码:　　//自动产生Code如下 　　library Project2; 　　//这有段废话 　　uses 　　SysUtils, 　　C
　　{$R *.RES}
　　begin 　　end.　　2.加个Func进来： 　　代码:　　library Project2; 　　uses 　　SysUtils, 　　C
Function MyMax ( X , Y : integer ) : begin && if X & Y then && Result := X && else && Result := Y ;
//切记：Library 的名字大小写没关系，可是DLL-Func的大小写就有关系了。 // 在 DLL-Func-Name写成MyMax与myMAX是不同的。如果写错了，立即 // 的结果是你叫用到此DLL的AP根本开不起来。 //参数的大小写就没关系了。甚至不必同名。如原型中是 (X,Y:integer)但引 // 用时写成(A,B:integer)，那是没关系的。 //切记：要再加个stdcall。书上讲，如果你是用Delphi写DLL，且希望不仅给 // Delphi-AP也希望BCB/VC-AP等使用的话，那你最好加个S 的指示 //参数型态：Delphi有很多种它自己的变量型态，这些当然不是DLL所喜欢的 // ，Windows/DLL的母语应该是C。所以如果要传进传出DLL的参数，我们 // 尽可能照规矩来用。这两者写起来，后者会麻烦不少。如果你对C不熟 // 的话，那也没关系。我们以后再讲。
　　{$R *.RES}
　　begin 　　end.　　3.将这些可共享的Func送出DLL，让外界﹝就是你的Delphi-AP啦﹞使用：光如此，你的AP还不能用到这些，你还要加个Exports才行。 　　代码: 　　{$R *.RES} 　　exports 　　MyM 　　begin 　　end.　　4.好了，可以按 Ctrl-F9编译了。此时可不要按F9。DLL不是EXE┌不可单独执行的，如果你按F9，会有ErrorMsg的。这时如果DLL有Error，请修正之。再按Ctrl-F9。此时可能有Warning，不要紧，研究一下，看看就好。再按Ctrl-F9，此时就『Done , Compiled 』。同目录就会有个 *.dll 。恭喜，大功告成了。 二、进行测试：开个新application： 　　1.加个TButton 　　代码:　　ShowMessage ( IntToStr(MyMax(30,50)) ) ;　　2.告知Exe到那里抓个Func 　　代码:　　//在Form,interface,var后加 　　Function MyMax ( X , Y : integer ) : external 'MyTestDLL.dll' ; 　　// MyTestDLL.dll为你前时写的DLL项目名字 　　// DLL名字大小写没关系。不过记得要加 extension的 .DLL。在Win95或NT， 　　// 是不必加 extension，但这两种OS，可能越来越少了吧。要加extension　　可以了，简单吧。　　上面的例子是不是很简单？熟悉Delphi的朋友可以看出以上代码和一般的Delphi程序的编写基本是相同的，只是在TestDll函数后多了一个stdcall参数并且用exports语句声明了TestDll函数。只要编译上面的代码，就可以玫揭桓雒?狣elphi.dll的动态链接库。现在，让我们来看看有哪些需要注意的地方：　　1.在DLL中编写的函数或过程都必须加上stdcall调用参数。在Delphi 1或Delphi 2环境下该调用参数是far。从Delphi 3以后将这个参数变为了stdcall，目的是为了使用标准的Win32参数传递技术来代替优化的register参数。忘记使用stdcall参数是常见的错误，这个错误不会影响DLL的编译和生成，但当调用这个DLL时会发生很严重的错误，导致操作系统的死锁。原因是register参数是Delphi的默认参数。 　　2.所写的函数和过程应该用exports语句声明为外部函数。 　　正如大家看到的，TestDll函数被声明为一个外部函数。这样做可以使该函数在外部就能看到，具体方法是单激鼠标右键用&快速查看（Quick View）&功能查看该DLL文件。（如果没有&快速查看&选项可以从Windows CD上安装。）TestDll函数会出现在Export Table栏中。另一个很充分的理由是，如果不这样声明，我们编写的函数将不能被调用，这是大家都不愿看到的。 　　3.当使用了长字符串类型的参数、变量时要引用ShareMem。 　　Delphi中的string类型很强大，我们知道普通的字符串长度最大为256个字符，但Delphi中string类型在默认情况下长度可以达到2G。（对，您没有看错，确实是两兆。）这时，如果您坚持要使用string类型的参数、变量甚至是记录信息时，就要引用ShareMem单元，而且必须是第一个引用的。既在uses语句后是第一个引用的单元。如下例： 　　uses 　　ShareMem,& SysUtils,& C还有一点，在您的工程文件（*.dpr）中而不是单元文件（*.pas）中也要做同样的工作，这一点Delphi自带的帮助文件没有说清楚，造成了很多误会。不这样做的话，您很有可能付出死机的代价。避免使用string类型的方法是将string类型的参数、变量等声明为Pchar或ShortString（如：s:string[10]）类型。同样的问题会出现在当您使用了动态数组时，解决的方法同上所述。 用Delphi制作DLL的方法一 Dll的制作一般步骤　　二 参数传递　　三 DLL的初始化和退出清理[如果需要初始化和退出清理]　　四 全局变量的使用　　五 调用静态载入　　六 调用动态载入　　七 在DLL建立一个TForM　　八 在DLL中建立一个TMDIChildForM　　九 示例：　　十 Delphi制作的Dll与其他语言的混合编程中常遇问题：　　十一 相关资料一 Dll的制作一般分为以下几步：　　1 .在一个DLL工程里写一个过程或函数　　2 .写一个Exports关键字，在其下写过程的名称。不用写参数和调用后缀。　　二 参数传递　　1 .参数类型最好与window C++的参数类型一致。不要用DELPHI的数据类型。　　2 .最好有返回值[即使是一个过程]，来报出调用成功或失败，或状态。成功或失败的返回值最好为1[成功]或0[失败].一句话，与windows c++兼容。　　3 .用stdcall声明后缀。　　4 .最好大小写敏感。　　5 .无须用far调用后缀，那只是为了与windows 16位程序兼容。　　三 DLL的初始化和退出清理[如果需要初始化和退出清理]　　1 .DLLProc[SysUtils单元的一个Pointer]是DLL的入口。在此你可用你的函数替换了它的入口。但你的函数必须符合以下要求[其实就是一个回调函数]。如下：　　procedure DllEnterPoint(dwReason: DWORD);
　　dwReason参数有四种类型：　　DLL_PROCESS_ATTACH:进程进入时　　DLL_PROCESS_DETACH进程退出时　　DLL_THREAD_ATTACH 线程进入时　　DLL_THREAD_DETACH 线程退出时　　在初始化部分写:　　DLLProc := @DLLEnterP　　DllEnterPoint(DLL_PROCESS_ATTACH);
　　2 .如Form上有TdcomConnection组件,就Uses Activex,在初始化时写一句CoInitialize (nil);　　3 .在退出时一定保证DcomConnection.Connected := False,并且数据集已关闭。否则报地址错。　　四 全局变量的使用　　在widnows 32位程序中，两个应用程序的地址空间是相互没有联系的。虽然DLL在内存中是一份，但变量是在各进程的地址空间中，因此你不能借助dll的全局变量来达到两个应用程序间的数据传递，除非你用内存映像文件。五 调用静态载入1 客户端函数声名:　1)大小写敏感。2)与DLL中的声明一样。如： showform(form:Tform);Fexternal'yproject_dll.dll';3)调用时传过去的参数类型最好也与windows c++一样。4)调用时DLL必须在windows搜索路径中，顺序是：当前目录；Path路径；&&& widows/windows/ssystem32; 　　六 调用动态载入　　1 .建立一种过程类型[如果你对过程类型的变量只是一个指针的本质清楚的话，你就知道是怎么回事了]。如：　　type　& 　mypointer=procedure(form:Tform);F　　var& 　　Hinst:T　& 　showform:　　begin　& 　Hinst:=loadlibrary('yproject_dll');//Load一个Dll,按文件名找。　& 　showform:=getprocaddress(Hinst,'showform');//按函数名找，大小写敏感。如果你知道自动化对象的本质就清楚了。　& 　showform(application.mainform);//找到函数入口指针就调用。& 　　Freelibrary(Hinst);　　
　　七 .在DLL建立一个TForM　　1 把你的Form Uses到Dll中，你的Form用到的关联的单元也要Uses进来[这是最麻烦的一点，因为你的Form或许Uses了许多特殊的单元或函数]　　2 传递一个Application参数，用它建立Form.　　八 .在DLL中建立一个TMDIChildForM　　1 Dll中的MDIForm.FormStyle不用为fmMDIChild.　　2 在CreateForm后写以下两句：　　function ShowForm(mainForm:TForm):stdcall　　var　& 　Form1: TForm1;& 　　ptr:PLongI　　begin& 　　ptr:=@(Application.MainForm);//先把dll的MainForm句柄保存起来，也无须释放，只不过是替换一下　& 　ptr^:=LongInt(mainForm);//用主调程序的mainForm替换DLL的MainForm。MainForm是特殊的WINDOW，它专门管理Application中的Forms资源.　& 　//为什么不直接Application.MainForm := mainForm,因为Application.MainForm是只读属性　& 　Form1:=TForm1.Create(mainForm);//用参数建立　　
　　备注：参数是主调程序的Application.MainForm九 .示例：　　DLL源代码：　　library Project2;　　uses　　SysUtils,& Classes,　Dialogs,　Forms,　　Unit2 in 'Unit2.pas' {Form2};　　{$R *.RES}　　var　& 　ccc: P　　procedure OpenForm(mainForm:TForm);　　var　　& Form1: TForm1;& 　　ptr:PLongI　　begin& 　　ptr:=@(Application.MainForm);& 　　ptr^:=LongInt(mainForm);　& 　Form1:=TForm1.Create(mainForm);　　　　procedure InputCCC(Text: Pchar);　　begin　　& ccc := T　　　　procedure ShowCCC;　　begin& 　　ShowMessage(String(ccc));　　　　exports　& 　OpenF　& 　InputCCC,& 　　ShowCCC;　　begin　　end.
　　调用方源代码：　　unit Unit1;　　interface　　uses　& 　Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,　　& StdC 　　type　　TForm1 = class(TForm)　　Button1: TB　　Button2: TB　　Edit1: TE　　procedure Button1Click(Sender: TObject);　　procedure Button2Click(Sender: TObject);　　private　　{ Private declarations }　　public　　{ Public declarations }　　　　var　& 　Form1: TForm1;　　implementation　　{$R *.DFM}　　procedure OpenForm(mainForm:TForm);External'project2.dll';　　procedure ShowCCC;External'project2.dll';　　procedure InputCCC(Text: Pchar);External'project2.dll';　　procedure TForm1.Button1Click(Sender: TObject);　　var& 　　Text: P　　begin& 　　Text := Pchar(Edit1.Text);& 　　// OpenForm(Application.MainForm);//为了调MDICHILD& 　　InputCCC(Text);//为了实验DLL中的全局变量是否在各个应用程序间共享　　　　procedure TForm1.Button2Click(Sender: TObject);　　begin& 　　ShowCCC;//这里表明WINDOWS 32位应用程序DLL中的全局变量也是在应用程序地址空间中，16位应用程序或许不同，没有做实验。　　
　　十 Delphi制作的Dll与其他语言的混合编程中常遇问题：　　1 .与PowerBuilder混合编程　　在定义不定长动态数组方面在函数退出清理堆栈时老出现不可重现的地址错，原因未明，大概与PB的编译器原理有关，即使PB编译成二进制代码也如此。在Delphi中静态调用DLL 　　调用一个DLL比写一个DLL要容易一些。首先给大家介绍的是静态调用方法，稍后将介绍动态调用方法，并就两种方法做一个比较。同样的，我们先举一个静态调用的例子。 unit Unit1;
uses && Windows, Messages, SysUtils, Classes, Graphics, && Controls, Forms, Dialogs, StdC
type & TForm1 = class(TForm) &&& Edit1: TE &&& Button1: TB &&& procedure Button1Click(Sender: TObject); & private &&& { Private declarations } & public &&& { Public declarations }
var & Form1: TForm1;
implementation
{$R *.DFM}
//本行以下代码为我们真正动手写的代码 function TestDll(i:integer): external &Delphi.dll&;
procedure TForm1.Button1Click(Sender: TObject); begin && Edit1.Text:=IntToStr(TestDll(1));
end.上面的例子中我们在窗体上放置了一个编辑框（Edit）和一个按钮（Button），并且书写了很少的代码来测试我们刚刚编写的Delphi.dll。大家可以看到我们唯一做的工作是将TestDll函数的说明部分放在了implementation中，并且用external语句指定了Delphi.dll的位置。（本例中调用程序和Delphi.dll在同一个目录中。）让人兴奋的是，我们自己编写的TestDll函数很快被Delphi认出来了。您可做这样一个实验：输入&TestDll（&，很快Delphi就会用fly-by提示条提示您应该输入的参数是什么，就像我们使用Delphi中定义的其他函数一样简单。注意事项有以下一些： 一、调用参数用stdcall 　　和前面提到的一样，当引用DLL中的函数和过程时也要使用stdcall参数，原因和前面提到的一样。 二、用external语句指定被调用的DLL文件的路径和名称 　　正如大家看到的，我们在external语句中指定了所要调用的DLL文件的名称。没有写路径是因为该DLL文件和调用它的主程序在同一目录下。如果该DLL文件在C:/，则我们可将上面的引用语句写为external &C:/Delphi.dll&。注意文件的后缀.dll必须写上。 三、不能从DLL中调用全局变量 　　如果我们在DLL中声明了某种全局变量，如：var s:byte 。这样在DLL中s这个全局变量是可以正常使用的，但s不能被调用程序使用，既s不能作为全局变量传递给调用程序。不过在调用程序中声明的变量可以作为参数传递给DLL。 四、被调用的DLL必须存在 　　这一点很重要，使用静态调用方法时要求所调用的DLL文件以及要调用的函数或过程等等必须存在。如果不存在或指定的路径和文件名不正确的话，运行主程序时系统会提示&启动程序时出错&或&找不到*.dll文件&等运行错误。 在Delphi中动态调用DLL 　　动态调用DLL相对复杂很多，但非常灵活。为了全面的说明该问题，这次我们举一个调用由C++编写的DLL的例子。首先在C++中编译下面的DLL源程序。 #include
extern &C& _declspec(dllexport) int WINAPI TestC(int i) {
}　　编译后生成一个DLL文件，在这里我们称该文件为Cpp.dll，该DLL中只有一个返回整数类型的函数TestC。为了方便说明，我们仍然引用上面的调用程序，只是将原来的Button1Click过程中的语句用下面的代码替换掉了。 procedure TForm1.Button1Click(Sender: TObject); type & TIntFunc=function(i:integer): var & Th:T & Tf:TIntF & Tp:TFarP begin & Th:=LoadLibrary(&Cpp.dll&); {装载DLL} & if Th&0 then &&& try &&&&& Tp:=GetProcAddress(Th,PChar(&TestC&)); &&&&& if Tp&&nil then&&&&& begin &&&&&&& Tf:=TIntFunc(Tp); &&&&&&& Edit1.Text:=IntToStr(Tf(1)); {调用TestC函数} &&&&& end &&&&& else &&&&&&& ShowMessage(&TestC函数没有找到&); &&& finally &&&&& FreeLibrary(Th); {释放DLL} &&& end & else &&& ShowMessage(&Cpp.dll没有找到&); 　　大家已经看到了，这种动态调用技术很复杂，但只要修改参数，如修改LoadLibrary(&Cpp.dll&)中的DLL名称为&Delphi.dll&就可动态更改所调用的DLL。 一、定义所要调用的函数或过程的类型 　　在上面的代码中我们定义了一个TIntFunc类型，这是对应我们将要调用的函数TestC的。在其他调用情况下也要做同样的定义工作。并且也要加上stdcall调用参数。 二、释放所调用的DLL 　　我们用LoadLibrary动态的调用了一个DLL，但要记住必须在使用完后手动地用FreeLibrary将该DLL释放掉，否则该DLL将一直占用内存直到您退出Windows或关机为止。 　　现在我们来评价一下两种调用DLL的方法的优缺点。静态方法实现简单，易于掌握并且一般来说稍微快一点，也更加安全可靠一些；但是静态方法不能灵活地在运行时装卸所需的DLL，而是在主程序开始运行时就装载指定的DLL直到程序结束时才释放该DLL，另外只有基于编译器和链接器的系统（如Delphi）才可以使用该方法。动态方法较好地解决了静态方法中存在的不足，可以方便地访问DLL中的函数和过程，甚至一些老版本DLL中新添加的函数或过程；但动态方法难以完全掌握，使用时因为不同的函数或过程要定义很多很复杂的类型和调用方法。对于初学者，笔者建议您使用静态方法，待熟练后再使用动态调用方法。 使用DLL的实用技巧 一、编写技巧 　　1 、为了保证DLL的正确性，可先编写成普通的应用程序的一部分，调试无误后再从主程序中分离出来，编译成DLL。 　　2 、为了保证DLL的通用性，应该在自己编写的DLL中杜绝出现可视化控件的名称，如：Edit1.Text中的Edit1名称；或者自定义非Windows定义的类型，如某种记录。 　　3 、为便于调试，每个函数和过程应该尽可能短小精悍，并配合具体详细的注释。 　　4 、应多利用try-finally来处理可能出现的错误和异常，注意这时要引用SysUtils单元。 　　5 、尽可能少引用单元以减小DLL的大小，特别是不要引用可视化单元，如Dialogs单元。例如一般情况下，我们可以不引用Classes单元，这样可使编译后的DLL减小大约16Kb。 二、调用技巧 　　1 、在用静态方法时，可以给被调用的函数或过程更名。在前面提到的C++编写的DLL例子中，如果去掉extern &C&语句，C++会编译出一些奇怪的函数名，原来的TestC函数会被命名为@TestC$s等等可笑的怪名字，这是由于C++采用了C++ name mangling技术。这个函数名在Delphi中是非法的，我们可以这样解决这个问题： 改写引用函数为 function TestC(i:integer): external &Cpp.dll&;其中name的作用就是重命名。 　　2 、可把我们编写的DLL放到Windows目录下或者Windows/system目录下。这样做可以在external语句中或LoadLibrary语句中不写路径而只写DLL的名称。但这样做有些不妥，这两个目录下有大量重要的系统DLL，如果您编的DLL与它们重名的话其后果简直不堪设想，况且您的编程技术还不至于达到将自己编写的DLL放到系统目录中的地步吧！ 三、调试技巧　　1 、我们知道DLL在编写时是不能运行和单步调试的。有一个办法可以，那就是在Run|parameters菜单中设置一个宿主程序。在Local页的Host Application栏中添上宿主程序的名字就可进行单步调试、断点观察和运行了。 　　2 、添加DLL的版本信息。开场白中提到了版本信息对于DLL是很重要的，如果包含了版本信息，DLL的大小会增加2Kb。增加这么一点空间是值得的。很不幸我们如果直接使用Project|options菜单中Version选项是不行的，这一点Delphi的帮助文件中没有提到，经笔者研究发现，只要加一行代码就可以了。如下例： library D
uses & SysUtils,& C
{$R *.RES} //注意，上面这行代码必须加在这个位置
function TestDll(i:integer): begin & Result:=i;
exports & TestD
begin end.3 、为了避免与别的DLL重名，在给自己编写的DLL起名字的时候最好采用字符数字和下划线混合的方式。如：jl_try16.dll。 　　4 、如果您原来在Delphi 1或Delphi 2中已经编译了某些DLL的话，您原来编译的DLL是16位的。只要将源代码在新的Delphi 3或Delphi 4环境下重新编译，就可以得到32位的DLL了。
[后记]：除了上面介绍的DLL最常用的使用方法外，DLL还可以用于做资源的载体。例如，在Windows中更改图标就是使用的DLL中的资源。另外，熟练掌握了DLL的设计技术，对使用更为高级的OLE、COM以及ActiveX编程都有很多益处。&&&&&&&对使用Delphi制作DLL复用文件的建议&在公司里有一些需要制作DLL的场合，因为熟悉、方便和简易，大多数使用Delphi来制作。现在就这个主题提出一些个人建议。尽量使用标准DLL接口。指的是传递的参数类型及函数返回类型不能是Delphi特有的，比如string（AnsiString），以及动态数组和含有这些类型成员的复合类型（如记录），也不能是包含有这些类型成员数据成员的对象类型，以避免可能的错误。如果使用了string类型或动态数组类型，且调用方不是Delphi程序，则基本上会报错。如果调用方是Delphi但调用方或被调用方没有在工程文件的第一包含单元不是ShareMem，也可能会出错。　　如果调用方是Delphi应用程序，则可能可以使用不包含禁止类型（string, 动态数组）数据成员的对象作为参数或返回值，但也应尽量避免。　　如果调用方与被调用方都是Delphi程序，而且要使用string或动态数组作参数，则双方工程文件的第一包含单元必须是ShareMem。（C++Builder程序的情况可能与此相同，不过没有测试过。）　　如果调用方不是Delphi程序，则string、动态数组、包含string或动态数组的复合数据类型及类实例，都不能作为参数及返回值。　　因此，为了提高DLL的复用范围，避免可能存在的错误，应当使用标准WIN32 API标准参数类型，以前使用string的变量，可以使用PChar(s)转换。动态数组则转换为指针类型（@array[0]），并加上数组的长度。　　如果因为调用方与被调用方都是Delphi程序，为了编写方便，不想进行上述转换，则推荐使用运行时包的形式。运行时包可以保证动态分配数据的正确释放。这样因为其扩展名（.bpl），显出该文件仅限于Delphi/C++Builder使用（不象DLL）。　　其次，尽量避免使用overload的函数/过程作输出，如果同一操作有多个方式，则可以让函数/过程名有少许差别，类似于Delphi中的FormatXXXX、CreateXXXX等函数及方法，如CreateByDefaultFile, CreateDefault。　　最后，作为DLL的提供者，应当提供直接编程的接口文件，如Delphi中的.pas或.dcu（最好是.pas，因为可以有注释）、C及C++中的.h和.lib。而不是让使用者们自己创建。如果非要有overload的函数/过程，这一点显得特别重要。另外，作为Delphi应用，提供的.pas文件可以是提前连接的（使用external指定DLL中的输出函数），也可以是后期连接的（使用LoadLibrary、GetProcAddress），DLL提供者提供编程接口文件，既显得正式（或HiQoS），又有保障。
排名：第9185名
（68）（30）（8）（2）（1）（0）（4）（0）Delphi编程地一些小程序
我的图书馆
Delphi编程地一些小程序
Delphi编程地一些小程序
1、用Enter键代替Tab键&在实际的程序开发中我们经常有这样的要求，用户不喜欢用Tab键，他希望用Enter键来代替。我们应该什么做呢？&首先：设定Form的KeyPreview属性为True。&其次：把Form上的所有Button的Default属性设为False。&最后：在Form的onKeyPress事件中添加如下代码：&procedure
TForm1.FormKeyPress(Sender: TO var Key: Char); begin&　if
Key = #13 then&　begin&　　Key :=
#0;&　　Perform(Wm_NextDlgCtl,0,0);&　&&--------------------------------------------------------------------------------&--作者：kgdyga&--发布时间：
13:10:38&--&2、命令行参数的使用&命令行参数的使用&Delphi提供了访问命令行参数的方便的方式，那就是使用ParamStr和ParamCount函数。其中ParamStr(0)返回的是当前程序名，如C:TESTMYPROG.EXE，ParamStr(1)返回第一个参数，以此类推；ParamCount则是参数个数。示例如下:&　　var&　　I:
I&　　begin&　　 Y :=
10;&　　 forI := 1 to ParamCount
do&begin&　　 Canvas.TextOut(5, Y,
ParamStr(I));&　　 Y := Y ＋ Canvas.TextHeight(ParamStr(I)) ＋
&　　&--------------------------------------------------------------------------------&--作者：kgdyga&--发布时间：
13:10:48&--&3、如何分行提示&Delphi中大部分控件都有一个实用的Hint属性，即浮动条提示。但有时提示较长，是否可以使得浮动提示条分行显示呢？其实，Hint是一个字符串（string），因而Delphi显示该字符串时会自动解释其中的回车控制符，所以只要加上回车控制符就可以了。依此原理，我们还能做出别具一格的垂直提示条。请先在form1中布置一个label，然后看示例代码：&procedure
TForm1.FormCreate(Sender:
TObject);&begin&label1.Hint
:=\'垂\'+#13+\'直\'+#13+\'提\'
+#13+\'示\';&&--------------------------------------------------------------------------------&--作者：kgdyga&--发布时间：
13:10:58&--&4、如何取得一个文件的文件类型呀&//要引用Shellapi单元&function
MrsGetFileType(const strFilename: string):
&var&FileInf
TSHFileI&begin&FillChar(FileInfo,
SizeOf(FileInfo), #0);&SHGetFileInfo(PChar(strFilename), 0,
FileInfo, SizeOf(FileInfo), SHGFI_TYPENAME);&Result :=
FileInfo.szTypeN&&--------------------------------------------------------------------------------&--作者：kgdyga&--发布时间：
13:11:08&--&5、取得当前操作平台&//定义在Type部分&TOSVersion
= (osUnknown, os95, os95OSR2, os98, os98SE, osNT3, osNT4, os2K,
osME,osXP);&{ *获得操作系统}&function GetOS
:TOSVersionI&OSVersion:TOSV&begin&ZeroMemory(@OS,SizeOf(OS));&OS.dwOSVersionInfoSize:=SizeOf(OS);&GetVersionEx(OS);&OSVersion:=osU&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&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;&&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\';&&--------------------------------------------------------------------------------&--作者：kgdyga&--发布时间：
13:11:17&--&6、ListView
排序的实现&ListView
排序&怎样实现单击一下按升序,再单击一下按降序。&function
CustomSortProc(Item1, Item2: TListI ColumnIndex: integer):
&begin&if ColumnIndex = 0
then&Result :=
CompareText(Item1.Caption,Item2.Caption)&else&Result
CompareText(Item1.SubItems[ColumnIndex-1],Item2.SubItems[ColumnIndex-1])&&procedure
TFrmSrvrMain.ListView1ColumnClick(Sender: TO&Column:
TListColumn);&begin&ListView1.CustomSort(@CustomSortProc,Column.Index);&&--------------------------------------------------------------------------------&--作者：kgdyga&--发布时间：
13:11:26&--&7、获取本机的IP地址&{*
获取本机的IP地址}&function GetLocalIP:
&type&TaPInAddr = array [0..10] of
PInA&PaPInAddr =
^TaPInA&var&phe:
PHostE&pptr : PaPInA&Buffer : array
[0..63]&I: I&GInitData:
TWSADATA;&begin&WSAStartup($101,
GInitData);&Result :=
\'\';&GetHostName(Buffer, SizeOf(Buffer));&phe
:=GetHostByName(buffer);&if phe = nil then
E&pptr := PaPInAddr(Phe^.h_addr_list);&I
:= 0;&while pptr^[i] && nil do
begin&result:=StrPas(inet_ntoa(pptr^[i]^));&Inc(I);&&WSAC&&--------------------------------------------------------------------------------&--作者：kgdyga&--发布时间：
13:11:36&--&8、获取本机的计算机名称&{*
获取本机的计算机名称}&function TNet.GetLocalName:
&var&CNameBuffer :
PC&fl_loaded : B&CLen :
^DW&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);&&--------------------------------------------------------------------------------&--作者：kgdyga&--发布时间：
13:11:45&--&9、让程序只运行一个实例Windows
下一个典型的特征就是多任务，我们可以同时打开多个窗口进行操作，也可以同时运行程序的多个实例，比如可以打开许多个资源管理器进行文件的移动复制操作。但有时出于某种考虑（比如安全性），我们要做出一些限制，让程序只能够运行一个实例。在Delphi编程中，笔者总结出了以下几种方法：&　　一、
查找窗口法&　　这是最为简单的一种方法。在程序运行前用FindWindow函数查找具有相同窗口类名和标题的窗口，如果找到了，就说明已经存在一个实例。在项目源文件的初始化部分添加以下代码：&　　Program
OneApp&　　Uses&　　Forms,W（这里介绍的几种方法均需在项目源文件中添加Windows单元，以后不再重复了）&　　Var
Hwnd:T&　　Begin&　　
Hwnd:=FindWindow(‘TForm1’，‘SingleApp’);&　　 If Hwnd=0
then&　　 Begin&　　
Application.I&　　 Application.CreateForm(Tform1,
Form1);&　　 Application.R&　　
E&　　E&　　FindWindow()函数带两个参数，FindWindow的第一个参数是类名，第二个参数是窗口标题,其中的一个参数可以忽略，但笔者强烈建议将两个参数都用上，免得凑巧别的程序也在使用相同的类名，就得不到正确的结果了。另外，如果是在Delphi
IDE窗口中运行该程序，将一次都不能运行，因为已经存在相同类名和标题的窗口：设计时的窗体。&　　二、使用互斥对象&　　如果觉得查找窗口的方法效率不太高的话，可以使用创建互斥对象的方法。尽管互斥对象通常用于同步连接，但用在这个地方也是非常方便的。仅用了4句代码就轻松搞定。&　　VAR
Mutex:TH&　　begin&　　
Mutex:=CreateMutex(NIL,True,‘SingleApp’);&　　 IF
GetLastError&&ERROR_ALREADY_EXISTS THEN//如果不存在另一实例&　　
BEGIN&　　 Application.CreateH&　　
Application.CreateForm (TExpNoteForm, ExpNoteForm);&　　
Application.R&　　 END;&　　
ReleaseMutex(Mutex);&　　end.&　　三、全局原子法&　　我们也可以利用向系统添加全局原子的方法，来防止多个程序实例的运行。全局原子由Windows
系统负责维持，它能保证其中的每个原子都是唯一的，管理其引用计数，并且当该全局原子的引用计数为0时，从内存中清除。我们用GlobalAddAtom
函数向全局原子添加一个255个字节以内的字符串，用GlobalFindAtom来检查是否已经存在该全局原子，最后在程序结束时用GlobalDeleteAtom函数删除添加的全局原子。示例如下：&　　Uses
Windows&　　const
iAtom=‘SingleApp’;&　　begin&　　 if
GlobalFindAtom(iAtom)=0 then&　　 begin&　　
GlobalAddAtom(iAtom);&　　
Application.I&　　
Application.CreateForm(TForm1,Form1);&　　
Application.R&　　
GlobalDeleteAtom(GlobalFindAtom(iAtom));&　　
end&　　 else&　　 MessageBox(0,‘You can not run a
second copy of this
App’,‘’,mb_OK);&　　end.&　　利用全局原子的引用计数规则，我们还可以判断当前共运行了该程序的多少个实例：&　　var
i:I&　　begin&　　
I:=0;&　　while GlobalFindAtom(iAtom)&&0
do&　　 begin&　　
GlobalDeleteAtom(GlobalFindAtom(iAtom));&　　
i:=i＋1;&　　&　　
ShowMessage(IntToStr(I));&　　&　　以上几种方法在笔者的Delphi
5.0，中文Windows2000下通过。&--------------------------------------------------------------------------------&--作者：kgdyga&--发布时间：
13:11:57&--&10、计算字符串中中文的字数&function
TotalChineseCount(ans: AnsiString):
I&var&wis:
WideS&begin&wis := WideString( ans
);&Result := Length( ans ) - Length( wis
);&&--------------------------------------------------------------------------------&--作者：kgdyga&--发布时间：
13:12:12&--&11、Virtual key
codes&Virtual Key Code Corresponding
key&VK_LBUTTON Left mouse button&VK_RBUTTON
Right mouse button&VK_CANCEL
Control+Break&VK_MBUTTON Middle mouse
button&VK_BACK Backspace key&VK_TAB Tab
key&VK_CLEAR Clear key&VK_RETURN Enter
key&VK_SHIFT Shift key&VK_CONTROL Ctrl
key&VK_MENU Alt key&VK_PAUSE Pause
key&VK_CAPITAL Caps Lock key&VK_KANA Used with
IME&VK_HANGUL Used with IME&VK_JUNJA Used with
IME&VK_FINAL Used with IME&VK_HANJA Used with
IME&VK_KANJI Used with IME&VK_CONVERT Used
with IME&VK_NONCONVERT Used with IME&VK_ACCEPT
Used with IME&VK_MODECHANGE Used with
IME&VK_ESCAPE Esc key&VK_SPACE Space
bar&VK_PRIOR Page Up key&VK_NEXT Page Down
key&VK_END End key&VK_HOME Home
key&VK_LEFT Left Arrow key&VK_UP Up Arrow
key&VK_RIGHT Right Arrow key&VK_DOWN Down
Arrow key&VK_SELECT Select key&VK_PRINT Print
key (keyboard-specific)&VK_EXECUTE Execute
key&VK_SNAPSHOT Print Screen key&VK_INSERT
Insert key&VK_DELETE Delete key&VK_HELP Help
key&VK_LWIN Left Windows key (Microsoft
keyboard)&VK_RWIN Right Windows key (Microsoft
keyboard)&VK_APPS Applications key (Microsoft
keyboard)&VK_NUMPAD0 0 key (numeric
keypad)&VK_NUMPAD1 1 key (numeric
keypad)&VK_NUMPAD2 2 key (numeric
keypad)&VK_NUMPAD3 3 key (numeric
keypad)&VK_NUMPAD4 4 key (numeric
keypad)&VK_NUMPAD5 5 key (numeric
keypad)&VK_NUMPAD6 6 key (numeric
keypad)&VK_NUMPAD7 7 key (numeric
keypad)&VK_NUMPAD8 8 key (numeric
keypad)&VK_NUMPAD9 9 key (numeric
keypad)&VK_MULTIPLY Multiply key (numeric
keypad)&VK_ADD Add key (numeric
keypad)&VK_SEPARATOR Separator key (numeric
keypad)&VK_SUBTRACT Subtract key (numeric
keypad)&VK_DECIMAL Decimal key (numeric
keypad)&VK_DIVIDE Divide key (numeric
keypad)&VK_F1 F1 key&VK_F2 F2
key&VK_F3 F3 key&VK_F4 F4
key&VK_F5 F5 key&VK_F6 F6
key&VK_F7 F7 key&VK_F8 F8
key&VK_F9 F9 key&VK_F10 F10
key&VK_F11 F11 key&VK_F12 F12
key&VK_F13 F13 key&VK_F14 F14
key&VK_F15 F15 key&VK_F16 F16
key&VK_F17 F17 key&VK_F18 F18
key&VK_F19 F19 key&VK_F20 F20
key&VK_F21 F21 key&VK_F22 F22
key&VK_F23 F23 key&VK_F24 F24
key&VK_NUMLOCK Num Lock key&VK_SCROLL Scroll
Lock key&VK_LSHIFT Left Shift key (only used with
GetAsyncKeyState and GetKeyState)&VK_RSHIFT Right Shift
key(only used with GetAsyncKeyState and
GetKeyState)&VK_LCONTROL Left Ctrl key(only used with
GetAsyncKeyState and GetKeyState)&VK_RCONTROL Right Ctrl
key(only used with GetAsyncKeyState and GetKeyState)&VK_LMENU
Left Alt key(only used with GetAsyncKeyState and
GetKeyState)&VK_RMENU Right Alt key(only used with
GetAsyncKeyState and GetKeyState)&VK_PROCESSKEY Process
key&VK_ATTN Attn key&VK_CRSEL CrSel
key&VK_EXSEL ExSel key&VK_EREOF Erase EOF
key&VK_PLAY Play key&VK_ZOOM Zoom
key&VK_NONAME Reserved for future use&VK_PA1
PA1 key&VK_OEM_CLEAR Clear
key&--------------------------------------------------------------------------------&--作者：kgdyga&--发布时间：
13:12:21&--&12、DELPHI中的快捷方式一览(完全正式版)&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
快速选择（呵呵，试试吧，很好玩的）&--------------------------------------------------------------------------------&--作者：kgdyga&--发布时间：
13:12:35&--&13、DbGrid控件的标题栏弹出菜单&procedure
TFrmOrderPost.DbgOrderPostMouseDown(Sender: TO Button: TMouseB
Shift: TShiftS X, Y:
Integer);&var&CurPost:TP&begin&GetCursorPos(CurPost);//获得鼠标当前坐标&if
(y&=17) and (x&=vCurRect.Right)
then&begin&if button=mbright
then&begin&PmTitle.Popup(CurPost.x,CurPost.y);&&&&//vCurRect该变量在DbGrid的DrawColumnCell事件中获得&{procedure
TFrmOrderPost.DbgOrderPostDrawColumnCell(Sender: TOconst Rect: TR
DataCol: I Column: TC State:
TGridDrawState);&begin&vCurRect:=R//vCurRect在实现部分定义&}&--------------------------------------------------------------------------------&--作者：kgdyga&--发布时间：
13:12:44&--&14.模拟按按下键盘键(如输入法中的软键盘)&//模拟在Edit组件中按下字母a键&PostMessage(Edit1.Handle,WM_KEYDOWN,65,0);&//模拟在窗体Form1中按下Tab键&PostMessage(Form1.Handle,WM_KEYDOWN,VK_TAB,0);&--------------------------------------------------------------------------------&--作者：kgdyga&--发布时间：
13:12:56&--&15.屏蔽系统功能键，如Ctrl+Alt+Del、Ctrl+Esc&var
tempint:&begin&SystemParametersinfo(SPI_SCREENSAVERRUNNING,1,@tempint,0);//屏蔽&SystemParametersinfo(SPI_SCREENSAVERRUNNING,0,@tempint,0);//取消屏蔽&--------------------------------------------------------------------------------&--作者：kgdyga&--发布时间：
13:13:07&--&网络函数&来自：在富翁&作者：daojianrumeng&unit
netF&interface&uses&SysUtils&,Windows&,dialogs&,winsock&,Classes&,ComObj&,WinInet&,V&//错误信息常量&const&C_Err_GetLocalIp
= \'获取本地ip失败\';&C_Err_GetNameByIpAddr=
\'获取主机名失败\';&C_Err_GetSQLServerList =
\'获取SQLServer服务器失败\';&C_Err_GetUserResource=
\'获取共享资失败\';&C_Err_GetGroupList =
\'获取所有工作组失败\';&C_Err_GetGroupUsers=
\'获取工作组中所有计算机失败\';&C_Err_GetNetList =
\'获取所有网络类型失败\';&C_Err_CheckNet =
\'网络不通\';&C_Err_CheckAttachNet =
\'未登入网络\';&C_Err_InternetConnected
=\'没有上网\';&C_Txt_CheckNetSuccess=
\'网络畅通\';&C_Txt_CheckAttachNetSuccess =
\'已登入网络\';&C_Txt_InternetConnected
=\'上网了\';&//得到本机的局域网Ip地址&Function
GetLocalIp(var LocalIp:string):
B&//通过Ip返回机器名&Function
GetNameByIPAddr(IPAddr: var MacName: string): Boolean
;&//获取网络中SQLServer列表&Function
GetSQLServerList(var List: Tstringlist):
B&//获取网络中的所有网络类型&Function
GetNetList(var List: Tstringlist):
B&//获取网络中的工作组&Function GetGroupList(var
List: TStringList):
B&//获取工作组中所有计算机&Function
GetUsers(GroupName: var List: TStringList):
B&//获取网络中的资源&Function
GetUserResource(IpAddr: var List: TStringList):
B&//映射网络驱动器&Function
NetAddConnection(NetPath: P PassWord: PLocalPath: Pchar):
B&//检测网络状态&Function
CheckNet(IpAddr:string):
B&//检测机器是否登入网络&Function
CheckMacAttachNet: B&//判断Ip协议有没有安装
这个函数有问题&Function IsIPInstalled :
&//检测机器是否上网&Function
InternetConnected: B&//关闭网络连接&function
NetCloseAll:&implementation&{=================================================================&功能:
检测机器是否登入网络&参数: 无&返回值:
成功:True失败:False&备 注:&版
09:55:00&=================================================================}&Function
CheckMacAttachNet: B&begin&Result :=
F&if GetSystemMetrics(SM_NETWORK) && 0
then&Result :=
T&&{=================================================================&功能:
返回本机的局域网Ip地址&参数: 无&返回值: 成功:True, 并填充LocalIp
失败:False&备 注:&版
21:05:00&=================================================================}&function
GetLocalIP(var LocalIp: string):
B&var&HostEnt:
PHostE&Ip:&addr:
&Buffer: array [0..63] of
&GInitData:
TWSADATA;&begin&Result :=
F&try&WSAStartup(2,
GInitData);&GetHostName(Buffer,
SizeOf(Buffer));&HostEnt :=
GetHostByName(buffer);&if HostEnt = nil then
E&addr := HostEnt^.h_addr_list^;&ip :=
Format(\'%d.%d.%d.%d\', [byte(addr [0]),&byte (addr [1]), byte
(addr [2]), byte (addr [3])]);&LocalIp :=
Ip;&Result :=
T&finally&WSAC&&&{=================================================================&功能:
通过Ip返回机器名&参数:&IpAddr:
想要得到名字的Ip&返回值: 成功:机器名 失败:\'\'&备
注:&inet_addr function converts a string containing an
Internet&Protocol dotted address into an
in_addr.&版 本:&1.
22:09:00&=================================================================}&function
GetNameByIPAddr(IPAddr : Svar MacName:String):
B&var&SockAddrIn:
TSockAddrIn;&HostEnt: PHostE&WSAData:
TWSAD&begin&Result :=
F&if IpAddr = \'\' then
&try&WSAStartup(2,
WSAData);&SockAddrIn.sin_addr.s_addr :=
inet_addr(PChar(IPAddr));&HostEnt :=
gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);&if
HostEnt && nil then&MacName :=
StrPas(Hostent^.h_name);&Result :=
T&finally&WSAC&&&{=================================================================&功能:
返回网络中SQLServer列表&参数:&List:
需要填充的List&返回值: 成功:True,并填充List失败 False&备
注:&版 本:&1.
22:44:00&=================================================================}&Function
GetSQLServerList(var List: Tstringlist):
&sRetvalue: S&SQLServer:
V&ServerList:
V&begin&Result :=
F&List.C&try&SQLServer
:= CreateOleObject(\'SQLDMO.Application\');&ServerList :=
SQLServer.ListAvailableSQLS&for i := 1 to
Serverlist.Count do&list.Add
(Serverlist.item(i));&Result :=
T&Finally&SQLServer :=
NULL;&ServerList :=
NULL;&&&{=================================================================&功能:
判断Ip协议有没有安装&参数: 无&返回值: 成功:True 失败:
F&备 注: 该函数还有问题&版
21:05:00&=================================================================}&Function
IsIPInstalled :&var&WSData:
TWSAD&ProtoEnt:
PProtoE&begin&Result :=
T&try&if WSAStartup(2,WSData) = 0
then&begin&ProtoEnt :=
GetProtoByName(\'IP\');&if ProtoEnt = nil
then&Result :=
False&&finally&WSAC&&&{=================================================================&功能:
返回网络中的共享资源&参数:&IpAddr:
机器Ip&List: 需要填充的List&返回值: 成功:True,并填充List 失败:
F&备 注:&WNetOpenEnum function starts an
enumeration of network&resources or existing
connections.&WNetEnumResource function continues a
network-resource&enumeration started by the WNetOpenEnum
function.&版 本:&1.
07:30:00&=================================================================}&--------------------------------------------------------------------------------&--作者：kgdyga&--发布时间：
13:13:19&--&Function GetUserResource(IpAddr:
var List: TStringList):
B&type&TNetResourceArray =
^TNetR//网络类型的数组&Var&i:
I&Buf: P&Temp:
TNetResourceA&lphEnum:
TH&NetResource:
TNetR&Count,BufSize,Res:
DW&Begin&Result :=
F&List.C&if copy(Ipaddr,0,2)
&& \'\\\\\' then&IpAddr := \'\\\\\'+IpA
//填充Ip地址信息&FillChar(NetResource, SizeOf(NetResource),
0);//初始化网络层次信息&NetResource.lpRemoteName :=
@IpAddr[1];//指定计算机名称&//获取指定计算机的网络资源句柄&Res :=
WNetOpenEnum( RESOURCE_GLOBALNET,
RESOURCETYPE_ANY,&RESOURCEUSAGE_CONNECTABLE,
@NetResource,lphEnum);&if Res && NO_ERROR then
//执行失败&while True
do//列举指定工作组的网络资源&begin&Count :=
$FFFFFFFF;//不限资源数目&BufSize :=
8192;//缓冲区大小设置为8K&GetMem(Buf,
BufSize);//申请内存，用于获取工作组信息&//获取指定计算机的网络资源名称&Res
:= WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);&if
Res = ERROR_NO_MORE_ITEMS//资源列举完毕&if (Res &&
NO_ERROR) then E//执行失败&Temp :=
TNetResourceArray(Buf);&for i := 0 to Count - 1
do&begin&//获取指定计算机中的共享资源名称，+2表示删除"\\\\"，&//如\\\\192.168.0.1
=& 192.168.0.1&List.Add(Temp^.lpRemoteName +
2);&Inc(Temp);&&&Res
:= WNetCloseEnum(lphEnum);//关闭一次列举&if Res && NO_ERROR
//执行失败&Result :=
T&FreeMem(Buf);&E&{=================================================================&功能:
返回网络中的工作组&参数:&List:
需要填充的List&返回值: 成功:True,并填充List 失败:
F&备注:&版本:&1.
08:00:00&=================================================================}&Function
GetGroupList( var List : TStringList ) :
B&type&TNetResourceArray =
^TNetR//网络类型的数组&Var&NetResource:
TNetR&Buf: P&Count,BufSize,Res:
DWORD;&lphEnum: TH&p:
TNetResourceA&i,j:
SmallI&NetworkTypeList:
TL&Begin&Result :=
F&NetworkTypeList :=
TList.C&List.C&//获取整个网络中的文件资源的句柄，lphEnum为返回名柄&Res
:= WNetOpenEnum( RESOURCE_GLOBALNET,
RESOURCETYPE_DISK,&RESOURCEUSAGE_CONTAINER,
Nil,lphEnum);&if Res && NO_ERROR//Raise
Exception(Res);//执行失败&//获取整个网络中的网络类型信息&Count
:= $FFFFFFFF;//不限资源数目&BufSize :=
8192;//缓冲区大小设置为8K&GetMem(Buf,
BufSize);//申请内存，用于获取工作组信息&Res := WNetEnumResource(lphEnum,
Count, Pointer(Buf),
BufSize);&//资源列举完毕//执行失败&if ( Res =
ERROR_NO_MORE_ITEMS ) or (Res && NO_ERROR ) then E&P
:= TNetResourceArray(Buf);&for i := 0 to Count - 1
do//记录各个网络类型的信息&begin&NetworkTypeList.Add(p);&Inc(P);&&Res
:= WNetCloseEnum(lphEnum);//关闭一次列举&if Res && NO_ERROR
&for j := 0 to NetworkTypeList.Count-1 do
//列出各个网络类型中的所有工作组名称&begin//列出一个网络类型中的所有工作组名称&NetResource
TNetResource(NetworkTypeList.Items[J]^);//网络类型信息&//获取某个网络类型的文件资源的句柄，NetResource为网络类型信息，lphEnum为返回名柄&Res
:= WNetOpenEnum(RESOURCE_GLOBALNET,
RESOURCETYPE_DISK,&RESOURCEUSAGE_CONTAINER,
@NetResource,lphEnum);&if Res && NO_ERROR then
//执行失败&while true
do//列举一个网络类型的所有工作组的信息&begin&Count :=
$FFFFFFFF;//不限资源数目&BufSize :=
8192;//缓冲区大小设置为8K&GetMem(Buf,
BufSize);//申请内存，用于获取工作组信息&//获取一个网络类型的文件资源信息，&Res
:= WNetEnumResource(lphEnum, Count, Pointer(Buf),
BufSize);&//资源列举完毕 //执行失败&if ( Res =
ERROR_NO_MORE_ITEMS ) or (Res && NO_ERROR)&P
:= TNetResourceArray(Buf);&for i := 0 to Count - 1
do//列举各个工作组的信息&begin&List.Add( StrPAS(
P^.lpRemoteName
));//取得一个工作组的名称&Inc(P);&&&Res
:= WNetCloseEnum(lphEnum);//关闭一次列举&if Res && NO_ERROR
//执行失败&&Result :=
T&FreeMem(Buf);&NetworkTypeList.D&E&{=================================================================&功能:
列举工作组中所有的计算机&参数:&List:
需要填充的List&返回值: 成功:True,并填充List 失败:
F&备注:&版本:&1.
08:00:00&=================================================================}&Function
GetUsers(GroupName: var List: TStringList):
B&type&TNetResourceArray =
^TNetR//网络类型的数组&Var&i:
I&Buf: P&Temp:
TNetResourceA&lphEnum:
TH&NetResource:
TNetR&Count,BufSize,Res:
DW&begin&Result :=
F&List.C&FillChar(NetResource,
SizeOf(NetResource), 0);//初始化网络层次信息&NetResource.lpRemoteName :=
@GroupName[1];//指定工作组名称&NetResource.dwDisplayType :=
RESOURCEDISPLAYTYPE_SERVER;//类型为服务器（工作组）&NetResource.dwUsage :=
RESOURCEUSAGE_CONTAINER;&NetResource.dwScope :=
RESOURCETYPE_DISK;//列举文件资源信息&//获取指定工作组的网络资源句柄&Res
:= WNetOpenEnum( RESOURCE_GLOBALNET,
RESOURCETYPE_DISK,&RESOURCEUSAGE_CONTAINER,
@NetResource,lphEnum);&if Res && NO_ERROR then E
//执行失败&while True
do//列举指定工作组的网络资源&begin&Count :=
$FFFFFFFF;//不限资源数目&BufSize :=
8192;//缓冲区大小设置为8K&GetMem(Buf,
BufSize);//申请内存，用于获取工作组信息&//获取计算机名称&Res :=
WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);&if Res
= ERROR_NO_MORE_ITEMS//资源列举完毕&if (Res &&
NO_ERROR) then E//执行失败&Temp :=
TNetResourceArray(Buf);&for i := 0 to Count - 1
do//列举工作组的计算机名称&begin&//获取工作组的计算机名称，+2表示删除"\\\\"，如\\\\wangfajun=&wangfajun&List.Add(Temp^.lpRemoteName
2);&inc(Temp);&&&Res
:= WNetCloseEnum(lphEnum);//关闭一次列举&if Res && NO_ERROR
//执行失败&Result :=
T&FreeMem(Buf);&&{=================================================================&功能:
列举所有网络类型&参数:&List:
需要填充的List&返回值: 成功:True,并填充List 失败: F&备
注:&版 本:&1.
08:54:00&=================================================================}&Function
GetNetList(var List: Tstringlist):
B&type&TNetResourceArray =
^TNetR//网络类型的数组&Var&p:
TNetResourceA&Buf: P&i:
SmallI&lphEnum: TH&NetResource:
TNetR&Count,BufSize,Res:
DWORD;&begin&Result :=
F&List.C&Res := WNetOpenEnum(
RESOURCE_GLOBALNET, RESOURCETYPE_DISK,&RESOURCEUSAGE_CONTAINER,
Nil,lphEnum);&if Res && NO_ERROR then
//执行失败&Count :=
$FFFFFFFF;//不限资源数目&BufSize :=
8192;//缓冲区大小设置为8K&GetMem(Buf,
BufSize);//申请内存，用于获取工作组信息&Res := WNetEnumResource(lphEnum,
Count, Pointer(Buf),
BufSize);//获取网络类型信息&//资源列举完毕//执行失败&if ( Res =
ERROR_NO_MORE_ITEMS ) or (Res && NO_ERROR ) then E&P
:= TNetResourceArray(Buf);&for i := 0 to Count - 1
do//记录各个网络类型的信息&begin&List.Add(p^.lpRemoteName);&Inc(P);&&Res
:= WNetCloseEnum(lphEnum); //关闭一次列举&if Res && NO_ERROR
//执行失败&Result :=
T&FreeMem(Buf);//释放内存&&{=================================================================&功能:
映射网络驱动器&参数:&NetPath:
想要映射的网络路径&Password: 访问密码&Localpath
本地路径&返回值: 成功:True失败: F&备
注:&版 本:&1.
09:24:00&=================================================================}&Function
NetAddConnection(NetPath: P PassWord: Pchar&;LocalPath:
Pchar): B&var&Res:
D&begin&Result :=
WNetAddConnection(NetPath,Password,LocalPath);&if Res &&
No_E&Result :=
T&&{=================================================================&--------------------------------------------------------------------------------&--作者：kgdyga&--发布时间：
13:13:31&--&功能:检测网络状态&参数:&IpAddr:
被测试网络上主机的IP地址或名称，建议使用Ip&返回值: 成功:True失败:
F&备 注:&版
09:40:00&=================================================================}&Function
CheckNet(IpAddr: string):
B&type&PIPOptionInformation =
^TIPOptionI&TIPOptionInformation = packed
record&TTL: B// Time To Live (used for
traceroute)&TOS: B// Type Of Service (usually
0)&Flags: B// IP header flags (usually
0)&OptionsSize: B// Size of options data (usually 0, max
40)&OptionsData: PC // Options data
buffer&&PIcmpEchoReply =
^TIcmpEchoR&TIcmpEchoReply = packed
record&Address: DW// replying
address&Status:DW// IP status value (see
below)&RTT: DW// Round Trip Time in
milliseconds&DataSize:W // reply data
size&Reserved:W&Data:P// pointer to
reply data buffer&Options: TIPOptionI // reply
options&&TIcmpCreateFile = function:
TH&TIcmpCloseHandle = function(IcmpHandle:
THandle): B&TIcmpSendEcho =
function(&IcmpHandle:TH&DestinationAddress:DW&RequestData:
P&RequestSize:
W&RequestOptions:PIPOptionI&ReplyBuffer:
P&ReplySize: DW&Timeout:
DWord&): DW
&const&Size =
32;&TimeOut =
1000;&var&wsadata:
TWSAD&Address: DW // Address of host to
contact&HostName, HostIP: S // Name and dotted IP of host
to contact&Phe: PHostE// HostEntry buffer for name
lookup&BufferSize, nPkts: I&pReqData,
pData: P&pIPE: PIcmpEchoR // ICMP Echo reply
buffer&IPOpt: TIPOptionI// IP Options for packet to
send&const&IcmpDLL =
\'icmp.dll\';&var&hICMPlib:
HM&IcmpCreateFile :
TIcmpCreateF&IcmpCloseHandle:
TIcmpCloseH&IcmpSendEchTIcmpSendE&hICMP:
TH // Handle for the ICMP Calls&begin&//
initialise winsock&Result:=T&if
WSAStartup(2,wsadata) && 0 then
begin&Result:=F&&&//
register the icmp.dll stuff&hICMPlib :=
loadlibrary(icmpDLL);&if hICMPlib && null then
begin&@ICMPCreateFile := GetProcAddress(hICMPlib,
\'IcmpCreateFile\');&@IcmpCloseHandle:=
GetProcAddress(hICMPlib, \'IcmpCloseHandle\');&@IcmpSendEch=
GetProcAddress(hICMPlib, \'IcmpSendEcho\');&if (@ICMPCreateFile
= Nil) or (@IcmpCloseHandle = Nil) or (@IcmpSendEcho = Nil) then
begin&Result:=F&&&hICMP
:= IcmpCreateF&if hICMP = INVALID_HANDLE_value then
begin&Result:=F&&&end
begin&Result:=F&&&//
------------------------------------------------------------&Address
:= inet_addr(PChar(IpAddr));&if (Address = INADDR_NONE) then
begin&Phe := GetHostByName(PChar(IpAddr));&if
Phe = Nil then Result:=False&else
begin&Address :=
longint(plongint(Phe^.h_addr_list^)^);&HostName :=
Phe^.h_&HostIP :=
StrPas(inet_ntoa(TInAddr(Address)));&&end&else
begin&Phe := GetHostByAddr(@Address, 4,
PF_INET);&if Phe = Nil then
Result:=F&&if Address = INADDR_NONE
then&begin&Result:=F&&//
Get some data buffer space and put something in the packet to
send&BufferSize := SizeOf(TICMPEchoReply) +
S&GetMem(pReqData, Size);&GetMem(pData,
Size);&GetMem(pIPE,
BufferSize);&FillChar(pReqData^, Size,
$AA);&pIPE^.Data := pD&// Finally Send the
packet&FillChar(IPOpt, SizeOf(IPOpt),
0);&IPOpt.TTL := 64;&NPkts :=
IcmpSendEcho(hICMP, Address, pReqData, Size,&@IPOpt, pIPE,
BufferSize, TimeOut);&if NPkts = 0 then
Result:=F&// Free those
buffers&FreeMem(pIPE); FreeMem(pData);
FreeMem(pReqData);&//
--------------------------------------------------------------&IcmpCloseHandle(hICMP);&FreeLibrary(hICMPlib);&//
free winsock&if WSACleanup && 0 then
Result:=F&&{=================================================================&功能:检测计算机是否上网&参数:无&返回值:成功:True失败:
F&备 注: uses Wininet&版
13:33:00&=================================================================}&function
InternetConnected: B&const&// local
system uses a modem to connect to the
Internet.&INTERNET_CONNECTION_MODEM= 1;&//
local system uses a local area network to connect to the
Internet.&INTERNET_CONNECTION_LAN= 2;&// local
system uses a proxy server to connect to the
Internet.&INTERNET_CONNECTION_PROXY= 4;&//
local system\'s modem is busy with a non-Internet
connection.&INTERNET_CONNECTION_MODEM_BUSY =
8;&var&dwConnectionTypes :
DWORD;&begin&dwConnectionTypes :=
INTERNET_CONNECTION_MODEM+ INTERNET_CONNECTION_LAN&+
INTERNET_CONNECTION_PROXY;&Result :=
InternetGetConnectedState(@dwConnectionTypes,
0);&&//关闭网络连接&function
NetCloseAll:&const&NETBUFF_SIZE=$208;&type&NET_API_STATUS=DWORD;&LPByte=PB&var&dwNetRet:DWORD;&i
:&dwEntries
:DWORD;&dwTotalEntries:DWORD;&szClient:LPWSTR;&dwUserName:DWORD;&Buff:array[0..NETBUFF_SIZE-1]of
&Adword:array[0..NETBUFF_SIZE div 4-1] of
&NetSessionEnum:function (
ServerName:LPSTR;&Reserved:DWORD;&Buf:LPB&BufLen:DWORD;&ConnectionCount:LPDWORD;&ConnectionToltalCount:LPDWORD
):NET_API_STATUS;&&NetSessionDel:function(
ServerName:LPWSTR;&UncClientName: LPWSTR
;&UserName:
dword):NET_API_STATUS;&&LibHandle :
TH&begin&Result:=&try&{
加载 DLL }&LibHandle :=
LoadLibrary(\'svrapi.dll\');&try&{
如果加载失败，LibHandle = 0.}&if LibHandle = 0
then&raise
Exception.Create(\'不能加载SVRAPI.DLL\');&{ DLL 加载成功，取得到 DLL
输出函数的连接然后调用 }&@NetSessionEnum := GetProcAddress(LibHandle,
\'NetSessionEnum\');&@NetSessionDel :=
GetProcAddress(LibHandle, \'NetSessionDel\');&if
(@NetSessionEnum = nil)or(@NetSessionDel=nil)
then&RaiseLastWin32Error { 连接函数失败
}&else&begin&dwNetRet :=
NetSessionEnum( nil,$32, @Buff,&NETBUFF_SIZE,
@dwEntries,&@dwTotalEntries );&if dwNetRet = 0
then&begin&Result :=
&for i:=0 to dwTotalEntries-1
do&begin&Move(Buff,Adword,NETBUFF_SIZE);&szClient:=LPWSTR(Adword[0]);&dwUserName
:= Adword[2];&dwNetRet := NetSessionDel(
nil,szClient,dwUserName);&if( dwNetRet && 0 )
then&begin&Result :=
&&&Move(Buff[26],Buff[0],NETBUFF_SIZE-(i+1)*26);&end&end&else&Result
&&finally&FreeLibrary(LibHandle);
// Unload the
DLL.&&except&&&end.&--------------------------------------------------------------------------------&--作者：kgdyga&--发布时间：
13:13:48&--&17、产生GUID&Uses
ComObj, ActiveX, W&function
GetGUID:&var&Id:
TGUID;&begin&if CoCreateGuid(Id) = S_OK
then&Result :=
GUIDToString(id);&&--------------------------------------------------------------------------------&--作者：kgdyga&--发布时间：
13:14:00&--&18、在ListBox移动鼠标时选择项目&procedure
TForm1.ListBox1MouseMove(Sender: TO Shift: TShiftS
X,&Y: Integer);&var&i:
&begin&i := y div
listbox1.ItemH&if (listbox1.TopIndex + i) &
listbox1.items.count
then&begin&listbox1.ItemIndex :=
listbox1.TopIndex +&caption :=
listbox1.Items[listbox1.ItemIndex];&&
(请您对文章做出评价)
上一篇：下一篇：
阅读(47) 评论()
最新IT新闻:· · · · · ?
最新知识库文章:
随笔分类(222)
随笔档案(210)
Delphi Android
馆藏&22198
TA的最新馆藏