1、怎样通过二级delphi经典中经典DELPHI8操作符重载的例子unit WinForm;interfaceusesSystem.Drawing, System.Collections, System.ComponentModel,System.Windows.Forms, System.Data;typeTWinForm = class(System.Windows.Forms.Form)$REGION Designer Managed Codestrict private/ / Required designer variable./ Components: System.Componen
2、tModel.Container;Button1: System.Windows.Forms.Button;/ / Required method for Designer support - do not modify/ the contents of this method with the code editor./ procedure InitializeComponent;procedure Button1_Click(sender: System.Object; e: System.EventArgs);$ENDREGIONstrict protected/ / Clean up
3、any resources being used./ procedure Dispose(Disposing: Boolean); override;private Private Declarations publicconstructor Create;end;/写成类也可以,这里我用了记录。由于记录是值类型省去了创建实例的麻烦TClassTest=recordpublicFA:Integer;/重载了“+”操作符class operator add(A,B:TClassTest):TClassTest;end;assembly: RuntimeRequiredAttribute(Type
4、Of(TWinForm)implementation$REGION Windows Form Designer generated code/ / Required method for Designer support - do not modify/ the contents of this method with the code editor./ procedure TWinForm.InitializeComponent;beginSelf.Button1 := System.Windows.Forms.Button.Create;Self.SuspendLayout;/ Butto
5、n1/Self.Button1.Location := System.Drawing.Point.Create(96, 88);Self.Button1.Name := Button1;Self.Button1.Size := System.Drawing.Size.Create(392, 112);Self.Button1.TabIndex := 0;Self.Button1.Text := Button1;Include(Self.Button1.Click, Self.Button1_Click);/ TWinForm/Self.AutoScaleBaseSize := System.D
6、rawing.Size.Create(6, 14);Self.ClientSize := System.Drawing.Size.Create(560, 357);Self.Controls.Add(Self.Button1);Self.Name := TWinForm;Self.Text := WinForm;Self.ResumeLayout(False);end;$ENDREGIONprocedure TWinForm.Dispose(Disposing: Boolean);beginif Disposing thenbeginif Components nil thenComponen
7、ts.Dispose();end;inherited Dispose(Disposing);end;constructor TWinForm.Create;begininherited Create;/ Required for Windows Form Designer support/InitializeComponent;/ TODO: Add any constructor code after InitializeComponent call/end;procedure TWinForm.Button1_Click(sender: System.Object; e: System.E
8、ventArgs);varA,B,C:TClassTest;beginA.FA :=1;B.FA :=2;C:=A+B; /两个结构(或者类)用+操作,在DELHI8以前是不可想象的system.Windows.Forms.MessageBox.Show(System.Convert.ToString(C.FA) );end; TClassTest /重载“+”操作符的实现class operator TClassTest.add(A, B: TClassTest): TClassTest;beginResult.FA:=A.FA + B.FA;end;end.delphitree从一个表复制
9、到另一个表由于 TREE从源表复制到目标表的ID号与PARENT会变化,故不能单纯的复制数据,还要将ID与PARENT的结构关系复制到目标表。因此我们用递归操作。由于 myquery 的数据会变动,全国计算机等级考试网,加入收藏我们要实时创建myquery 。下面是 delphi tree 从一个表复制到另一个表 的递归源码:Procedure Tfrm_SysDepasManager.CopyTree(socParent, desParent: integer); /树递归复制过程Varmyquery: TADOQuery;mysoc, mydes: integer;Beginmyquery
10、 := Tadoquery.Create(Nil);Trymyquery.Connection := frmdata.ADOConnection1;myquery.Active := false;myquery.SQL.Clear;myquery.SQL.Add(select * from LCConstDepa where parent= + inttostr(socParent);myquery.Active := true;/插记录While Not myquery.Eof DoBeginmysoc := myquery.FieldByName(ID).AsInteger;ReDataS
11、et2.Append;ReDataSet2.FieldByName(shlid).AsInteger := Syspublic.LoginSchoolID;ReDataSet2.FieldByName(name).AsString := myquery.FieldByName(name).AsString;ReDataSet2.FieldByName(pinyin).AsString := myquery.FieldByName(pinyin).AsString;ReDataSet2.FieldByName(parent).AsInteger := desParent;ReDataSet2.P
12、ost;mydes := ReDataSet2.FieldByName(ID).AsInteger;CopyTree(mysoc, mydes);myquery.Next;End;Finallymyquery.Free;End;End;Delphi实现对注册表的监视和扫描Delphi自带的TRegistry类只能实现注册表的基本操作,如果我们要实时监视注册表的变化或者扫描注册表特定项下的所有子项,TRegistry类就无能为力了。我啃了半天SDK,终于实现了Delphi对注册表的监视与扫描,不敢独享,拿来献给广大的Delphi爱好者。监视注册表相关项的改变要用到一个API:RegNotifyC
13、hangeKeyValue。LONG RegNotifyChangeKeyValue(HKEY hKey, / 要监视的一个项的句柄BOOL bWatchSubtree, / 是否监视此项的子键DWORD dwNotifyFilter, / 监视哪些变化HANDLE hEvent, / 接受注册表变化事件的事件对象句柄BOOL fAsynchronous/ 注册表变化前报告还是注册表变化后才报告);注意上面的hEvent是接受注册表变化事件的事件对象句柄,我们要用API:CreateEvent来创建一个系统事件对象。HANDLE CreateEvent(LPSECURITY_ATTRIBUTE
14、S lpEventAttributes, / SECURITY_ATTRIBUTES结构BOOL bManualReset, / 是否自动重置BOOL bInitialState, / 是否设置初始状态LPCTSTR lpName/ 事件对象的名称);新建一个工程,添加一个ListBox,两个Button。/先写个监视注册表的例子/监视HKEY_CURRENT_USERSoftware项下所有子键procedure TForm1.Button1Click(Sender: TObject);varhNotify : THandle;hKeyx : HKEY;dwRes : DWORD;begin
15、hNotify := CreateEvent( nil, /不使用SECURITY_ATTRIBUTES结构FALSE, /不自动重置TRUE,/设置初始状态RegistryNotify /事件对象的名称);if hNotify = 0 thenbeginShowmessage(CreateEvent failed.);exit;end;if RegOpenKeyEx( HKEY_CURRENT_USER, /跟键Software, /子键0, /reservedKEY_NOTIFY, /监视用hKeyx /保存句柄) ERROR_SUCCESS thenbeginCloseHandle( h
16、Notify );Showmessage(RegOpenKeyEx failed.);exit;end;if RegNotifyChangeKeyValue( hKeyx, /监视子键句柄TRUE, /监视此项的子键REG_NOTIFY_CHANGE_NAME or REG_NOTIFY_CHANGE_LAST_SET,hNotify, /接受注册表变化事件的事件对象句柄TRUE /注册表变化前报告) ERROR_SUCCESS thenbeginCloseHandle( hNotify );RegCloseKey( hKeyx );Showmessage(RegNotifyChangeKey
17、Value failed);exit;end;dwRes := WaitForSingleObject( hNotify, 60 * 1000 ); /监视一分钟if dwRes = 0 thenShowmessage( Registry will be changed. );CloseHandle( hNotify );RegCloseKey( hKeyx );end;要注意的是,API: WaitForSingleObject要等到注册表变化事件发生或者超时才会返回,在此期间我们的程序将失去响应。解决的办法是新建一个线程,在新线程中监视注册表。对注册表进行扫描要用到另外两个API: Reg
18、EnumKey和RegEnumValue。LONG RegEnumKey(HKEY hKey, / 要扫描的注册表项目句柄DWORD dwIndex, / 要扫描的subkey序号LPTSTR lpName, / 要扫描的subkey名称LPDWORD lpcbName, / 要扫描的subkey名称占用空间);此函数的使用方法是: 首先给dwIndex赋值0, 调用RegEnumKey; 然后Inc(dwIndex), 再调用RegEnumKey,直到返回值为ERROR_NO_MORE_ITEMS,表示没有更多的子项了。/扫描注册表的例子/只演示了如何枚举HKEY_CURRENT_USERS
19、oftware下的一层子项procedure TForm1.Button2Click(Sender: TObject);varbuf : array 0.255 of char;iRes: integer;hKeyx : HKEY;dwIndex, dwSize : DWORD;beginif RegOpenKeyEx( HKEY_CURRENT_USER, Software, 0, KEY_READ orKEY_ENUMERATE_SUB_KEYS, hKeyx ) ERROR_SUCCESS thenbeginShowmessage(RegOpenKeyEx failed.);exit;e
20、nd;dwIndex := 0;repeatdwSize := 255;iRes := RegEnumKey( hKeyx, dwIndex, buf, dwSize );if iRes = ERROR_NO_MORE_ITEMS thenbreakelse if iRes = ERROR_SUCCESS thenbeginListbox1.Items.Add( buf );Inc( dwIndex );end;until iRes ERROR_SUCCESS;RegCloseKey( hKeyx );end;tryif NTNetGetDCName(nil, nil, pDomain) =
21、0 thenResult := WideCharToString(pDomain);finallyNTNetApiBufferFree(pDomain);end;finallyFreeLibrary(Libhandle);end;end;function GetDomainName: AnsiString;typeWKSTA_INFO_100 = recordwki100_platform_id: Integer;wki100_computername: PWideChar;wki100_langroup: PWideChar;wki100_ver_major: Integer;wki100_
22、ver_minor: Integer;end; WKSTA_USER_INFO_1 = recordwkui1_username: PChar;wkui1_logon_domain: PChar;wkui1_logon_server: PChar;wkui1_oth_domains: PChar;end;type/Win9X ANSI prototypes from RADMIN32.DLL and RLOCAL32.DLLTWin95_NetUserGetInfo = function(ServerName, UserName: PChar; Level: DWORD; varBfrPtr:
23、 Pointer): Integer;stdcall;TWin95_NetApiBufferFree = function(BufPtr: Pointer): Integer;stdcall;TWin95_NetWkstaUserGetInfo = function(Reserved: PChar; Level: Integer; varBufPtr: Pointer): Integer;stdcall;/WinNT UNICODE equivalents from NETAPI32.DLLTWinNT_NetWkstaGetInfo = function(ServerName: PWideC
24、har; level: Integer; varBufPtr: Pointer): Integer;stdcall;TWinNT_NetApiBufferFree = function(BufPtr: Pointer): Integer;stdcall;varWin95_NetUserGetInfo: TWin95_NetUserGetInfo;Win95_NetWkstaUserGetInfo: TWin95_NetWkstaUserGetInfo;Win95_NetApiBufferFree: TWin95_NetApiBufferFree;WinNT_NetWkstaGetInfo: T
25、WinNT_NetWkstaGetInfo;WinNT_NetApiBufferFree: TWinNT_NetApiBufferFree;WSNT: WKSTA_INFO_100;WS95: WKSTA_USER_INFO_1;EC: DWORD;hNETAPI: THandle;begintryResult := ;if IsWinNT thenbeginhNETAPI := LoadLibrary(NETAPI32.DLL);if hNETAPI 0 thenbegin WinNT_NetWkstaGetInfo := GetProcAddress(hNETAPI, NetWkstaGe
26、tInfo);WinNT_NetApiBufferFree := GetProcAddress(hNETAPI, NetApiBufferFree);EC := WinNT_NetWkstaGetInfo(nil, 100, Pointer(WSNT);if EC = 0 thenbeginResult := WideCharToString(WSNT.wki100_langroup);WinNT_NetApiBufferFree(Pointer(WSNT);end;end;endelsebeginhNETAPI := LoadLibrary(RADMIN32.DLL);if hNETAPI
27、0 thenbegin Win95_NetApiBufferFree := GetProcAddress(hNETAPI, NetApiBufferFree);Win95_NetUserGetInfo := GetProcAddress(hNETAPI, NetUserGetInfoA);EC := Win95_NetWkstaUserGetInfo(nil, 1, Pointer(WS95);if EC = 0 thenbeginResult := WS95.wkui1_logon_domain;Win95_NetApiBufferFree(Pointer(WS95);end;end;end
28、;finallyif hNETAPI 0 thenFreeLibrary(hNETAPI);end;end;function AppendShareResource(ServerName,FilePath,NetName, Remark : string): Integer;varShInfo: TSHARE_INFO_502;parm_err:PDWORD;_FilePath,_NetName, _Remark : PWideChar ;_ServerName : Pchar ;LibHandle : THandle;beginLibHandle := LoadLibrary(NTlib);if LibHa
copyright@ 2008-2022 冰豆网网站版权所有
经营许可证编号:鄂ICP备2022015515号-1