当前位置：
> > 查看文章
第一个程序 – 零基础入门学习Delphi01
第一个程序
让编程改变世界
Change the world by program
Delphi简介：聪明的人使用Delphi, 真正的程序员使用C++！
Delphi是著名的Borland公司开发的可视化软件开发环境，自1995年问世以来，带来了程序设计中的一场重大变化。
Delphi作为第四代编程语言，具有简单、高效和功能强大等特点，这些特点使得它为广大程序开发者所青睐。
Delphi的易用性和稳定性更是高手追求的境界！另外值得说的是，Delphi的VCL架构是开源的。
话说有一天，VB、VC、DELPHI……乘坐火车出游，半路火车头坏了，大家很着急！
这时候，爱出风头的Mr.VB说：“我来为大家造一个火车头吧！”说干就干，Mr.VB在树林中砍伐木头，一阵叮叮当当……
一个新的火车头出现了。Mr.VB让大家上车，然后大喊：“开车喽——”结果，没有反应。
Mr.VB经过多次实验后，突然恍然大悟：“哎呀，这个车头没有安装我的运行库！……运行库我可没有随身带着！！！……”
Mr.VC生气了，“不象话，看我的！”于是Mr.VC又开始忙活起来。干了一会，Mr.VC停下来，说：“怎么炼铁？我记不清了，需要查查资料。”
Mr.VC拿出MSDN开始……，接着又干，一会又停下来，“我还要查查资料……”
天色已晚，Mr.DELPHI终于沉不住气了，他开始在坏火车头里翻找，结果发现有许多“组件”和“控件”还可以利用，于是Mr.DELPHI开始组装，没有多久，一个“新的”火车头出现了……
汽笛长鸣，火车拉着沮丧的Mr.VB、仍在沉思的Mr.VC……又上路了！！
以上的一个不算能哄小孩子睡觉的小故事，说明了很多赤裸裸的真理；
其实有很多朋友选择易语言来进行学习，由于易语言有中文界面还相当容易使用。
但小甲鱼在这里可以很负责任地告诉大家，Delphi 在易用性和易学性方面绝对不会让大家失望。
最后，不管你们信不信，反正我是信了！
Delphi7的下载和安装
Delphi7的主窗口
Delphi7的主窗口
有如下3种方法向窗体添加组件
单击组件板上的组件，然后在窗体的适当位置单击并拖动鼠标。
直接双击组件，可将该组件添加到窗体的中心位置。
按住Shift键不放……
Delphi7的窗体设计器
Delphi7的窗体设计器
分页阅读：
小甲鱼在干啥
如果您觉得小甲鱼的视频能够给您带来知识和快乐，您可以选择赞助我们，让我们可以持续为您推出更多精彩的原创编程教学^_^
手机用户打开支付宝钱包，扫描下方支付宝二维码即可：
电脑用户点击下方按钮即可跳转至支付宝转账页面：
感谢您对我们发展的支持和认可！
更多新鲜事儿
加载中……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) 评论(0)
注册用户登录后才能发表评论，请
或 ，网站首页。
最新IT新闻:· · · · ·
最新知识库文章:
随笔分类(222)
随笔档案(210)
馆藏&24048
TA的最新馆藏
喜欢该文的人也喜欢