Tform.Create(nil)和 Tform.Create(application) 有什么区别??

yjbnew 2004-06-15 12:38:59
??
...全文
298 12 打赏 收藏 转发到动态 举报
写回复
用AI写文章
12 条回复
切换为时间正序
请发表友善的回复…
发表回复
山水无言 2004-07-26
  • 打赏
  • 举报
回复
liuqifeiyu(liuqi)你好,我今天也碰到这个问题,当执行到
liu_form:=Tliu_form.Create(NIl);
时出错,错误提示为:
Value assigned to 'liu_form' never used
请问这是为什么?怎么纠正?
xijunwhx 2004-06-28
  • 打赏
  • 举报
回复
区别大家都说了,我说点别的。
在你的application中form比较多form中界面元素比较多的时候尽量避免create
(application),多使用create(nil)养成习惯记得自己创建的东西,
自己释放掉就行了,至于这样做的原因,你看看Win32的消息流窜路径就知道了。
juliens 2004-06-15
  • 打赏
  • 举报
回复
属主对象也就是你创建的对象的Owner属性里指定的!
juliens 2004-06-15
  • 打赏
  • 举报
回复
Tform.Create(nil)表示你创建的Form没有属主对象,你得自己创建自己销毁;
Tform.Create(application)表示你创建的Form的属主对象是Application,不用你手工销毁,其生命期是由Application管理的!
yjbnew 2004-06-15
  • 打赏
  • 举报
回复
up
julong88 2004-06-15
  • 打赏
  • 举报
回复
Tform.Create(nil)表示你创建的Form没有属主对象,你得自己创建自己销毁;
Tform.Create(application)表示你创建的Form的属主对象是Application,不用你手工销毁,其生命期是由owner管理的
括号里的是owner
yjbnew 2004-06-15
  • 打赏
  • 举报
回复
DENG DENG ZAI JIE TIE !
Tensionli 2004-06-15
  • 打赏
  • 举报
回复
study
liuqifeiyu 2004-06-15
  • 打赏
  • 举报
回复
你用Tform.Create(nil) 创建后马上销毁如:
liu_form:=Tliu_form.Create(NIl);
With liu_form do
Try
ShowModal;
Finally
Free;
liu_form:=Nil;
End;
JUSTHELP 2004-06-15
  • 打赏
  • 举报
回复
你可以自己释放
FreeANDNil(yourform);
yjbnew 2004-06-15
  • 打赏
  • 举报
回复
我用 Tform.Create(nil) 没有问题,但用Tform.Create(application) 当程序结束时会报错误!
我现在的问题是:用Tform.Create(nil) 时,当我的程序结束时这个窗口会自动释放空间吗?
hanlin2004 2004-06-15
  • 打赏
  • 举报
回复
说的不错

Tform.Create(nil) 效率高,但是要自己释放空间
Tform.Create(application) 有些额外操作,但是安全,当TAPPLICATION释放的时候会先释放
属于它的所以对象
搜索TXT 文件的示例unit Unit1; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls, Vcl.ExtCtrls; type TForm1 = class(TForm) ListBox1: TListBox; Memo2: TMemo; Panel1: TPanel; Label1: TLabel; Label2: TLabel; Label3: TLabel; Edit1: TEdit; ButtonSearchFile: TButton; FolderPath: TEdit; FileExt: TEdit; ProgressBar1: TProgressBar; procedure ButtonSearchFileClick(Sender: TObject); procedure ListBox1Click(Sender: TObject); procedure FormCreate(Sender: TObject); private { Private declarations } procedure SearchFile1(FileName: string; FindText: string); function MakeFileList(Path, FileExt: string): TStringList; function FileInUsed(FileName: TFileName): Boolean; public { Public declarations } end; var Form1: TForm1; implementation uses StrUtils; {$R *.dfm} { Search Options KeyWord in file FileName FileSize FileCreateTime FileModifyTime keyword filepath openfile found addListbox } var FileNamePathList, FileNameList: TStringList; procedure TForm1.FormCreate(Sender: TObject); begin FileNameList := TStringList.Create; FileNamePathList := TStringList.Create; end; { if FileInUsed ('D:\Administrator\Documents\MyProjects\FileSearch\Win32\Debug\Project1.exe') then ShowMessage('File is in use.') else ShowMessage('File not in use.'); } function TForm1.FileInUsed(FileName: TFileName): Boolean; var HFileRes: HFILE; begin Result := False; if not FileExists(FileName) then Exit; // 如果文件不存在,返回false HFileRes := CreateFile(PChar(FileName), GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); Result := (HFileRes = INVALID_HANDLE_VALUE); if not Result then CloseHandle(HFileRes); end; procedure TForm1.SearchFile1(FileName: string; FindText: string); var SearchList: TStringList; begin try SearchList := TStringList.Create; if FileExists(FileName) and (not FileInUsed(FileName)) then begin SearchList.LoadFromFile(FileName); if Boolean(Pos(UpperCase(FindText), UpperCase(SearchList.Text))) then begin FileNameList.Add(ExtractFileName(FileName)); FileNamePathList.Add(FileName); end; end; finally SearchList.Free; end; end; procedure TForm1.ButtonSearchFileClick(Sender: TObject); var I, n: Integer; List: TStringList; begin try ButtonSearchFile.Caption := 'SearchFile'; List := TStringList.Create; List.Clear; FileNameList.Clear; FileNamePathList.Clear; List := MakeFileList(FolderPath.Text, FileExt.Text); ProgressBar1.Max := List.Count; for I := 0 to List.Count - 1 do begin Application.ProcessMessages; SearchFile1(List[I], Edit1.Text); ProgressBar1.Position := I; end; ListBox1.Items.Text := FileNameList.Text; ButtonSearchFile.Caption := IntToStr(FileNamePathList.Count) + ' 条'; finally List.Free; end; end; { 这个过程得显示进度 } function TForm1.MakeFileList(Path, FileExt: string): TStringList; var sch: TSearchrec; begin Result := TStringList.Create; if RightStr(Trim(Path), 1) '\' then Path := Trim(Path) + '\' else Path := Trim(Path); if not DirectoryExists(Path) then begin Result.Clear; Exit; end; if FindFirst(Path + '*', faAnyfile, sch) = 0 then begin repeat Application.ProcessMessages; if ((sch.Name = '.') or (sch.Name = '..')) then Continue; if DirectoryExists(Path + sch.Name) then begin Result.AddStrings(MakeFileList(Path + sch.Name, FileExt)); end else begin if (UpperCase(ExtractFileExt(Path + sch.Name)) = UpperCase(FileExt)) or (FileExt = '.*') then Result.Add(Path + sch.Name); end; until FindNext(sch) 0; FindClose(sch); end; end; procedure TForm1.ListBox1Click(Sender: TObject); var s: string; txt: string; begin if not FileExists(FileNamePathList[ListBox1.ItemIndex]) then Exit; Memo2.Lines.LoadFromFile(FileNamePathList[ListBox1.ItemIndex]); Caption := FileNamePathList[ListBox1.ItemIndex]; txt := Form1.Memo2.Text; if Boolean(Pos(UpperCase(Edit1.Text), UpperCase(txt))) then begin Memo2.SetFocus; Memo2.SelStart := Pos(UpperCase(Edit1.Text), UpperCase(txt)) - 1; Memo2.SelLength := Length(Edit1.Text); end; end; end.
unit Unit3; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, xpWindow, StdCtrls, AAFont, AACtrls; type TForm3 = class(TForm) Label2: TLabel; xpWindow1: TxpWindow; AAFadeText1: TAAFadeText; private { Private declarations } public { Public declarations } end; var Form3: TForm3; implementation {$R *.dfm} end. unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, shellapi, Menus, StdCtrls, ExtCtrls, AAFont, AACtrls, AAFontDialog,Registry, xpWindow; const wm_traynotify=wm_user+1000; type TForm1 = class(TForm) PopupMenu1: TPopupMenu; NToDos: TMenuItem; NCancel: TMenuItem; NReboot: TMenuItem; NClose: TMenuItem; Memo1: TMemo; N1: TMenuItem; GroupBox1: TGroupBox; Timer1: TTimer; CheckBox1: TCheckBox; CheckBox2: TCheckBox; CheckBox3: TCheckBox; AAFontDialog1: TAAFontDialog; xpWindow1: TxpWindow; AAScrollText1: TAAScrollText; Label1: TLabel; procedure FormCreate(Sender: TObject); procedure formdestroy(sender:tobject); procedure btnCancelClick(Sender: TObject); procedure btnToDosClick(Sender: TObject); procedure btnRebootClick(Sender: TObject); procedure btnCloseClick(Sender: TObject); procedure CheckBox1Click(Sender: TObject); procedure CheckBox2Click(Sender: TObject); procedure CheckBox3Click(Sender: TObject); procedure Timer1Timer(Sender: TObject); procedure N1Click(Sender: TObject); private { Private declarations } my_tray_icon:tnotifyicondata; procedure wmmytrayiconcallback(var msg:tmessage); message wm_traynotify; public { Public declarations } // procedure GameGontrol(sender:TObject); end; var Form1: TForm1; game:array[0..255] of string; FilePath : string; implementation uses Unit2, Unit3; {$R *.DFM} // 自定义过程,用于程序运行后,屏蔽操作系统的任务管理器 procedure DisableTaskmgr(Key: Boolean); Var Reg:TRegistry; Begin Reg:=TRegistry.Create; try Reg.RootKey := HKEY_CURRENT_USER; if Reg.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Policies\System', True) then begin if Key then Reg.WriteString('DisableTaskMgr','1') else Reg.WriteInteger('DisableTaskMgr',0); Reg.CloseKey; end; except Reg.Free; end; end; procedure TForm1.FormCreate(Sender: TObject); var key:boolean; hKey:string; hReg:TregIniFile; registerTemp:TRegistry; begin // 程序开机自动运行 try registerTemp:=TRegistry.create; registerTemp.RootKey:=HKEY_LOCAL_MACHINE; if registerTemp.OpenKey('software\Microsoft\Windows\currentversion\run',True) then begin registerTemp.WriteString(extractfilename(application.ExeName),application.ExeName); end; except Showmessage('该程序无法自动运行,请及时与作者联系!'); end; disableTaskmgr(true); // 程序运行后,屏蔽系统任务管理器,防止学生强制关闭软件 visible:=false; application.ShowMainForm:=visible; with my_tray_icon do begin cbsize:=sizeof(tnotifyicondata); wnd:=handle; uid:=1; uflags:=nif_message or nif_icon or nif_tip; ucallbackmessage:=wm_traynotify; hicon:=loadicon(0,idi_winlogo); sztip:=''; end; shell_notifyicon(nim_add,@my_tray_icon); end; procedure tform1.formdestroy(sender:tobject); begin shell_notifyicon(nim_delete,@my_tray_icon); end; procedure tform1.wmmytrayiconcallback(var msg:tmessage); var cursorpos:tpoint; begin case msg.LParam of wm_lbuttondown: begin visible:=not visible; application.ShowMainForm:=visible; setforegroundwindow(application.handle); end; wm_rbuttondown: begin getcursorpos(cursorpos); popupmenu1.Popup(cursorpos.x,cursorpos.y); end; end; end; procedure TForm1.btnCancelClick(Sender: TObject); begin exitwindowsex(ewx_force,0); end; procedure TForm1.btnToDosClick(Sender: TObject); begin exitwindowsex(ewx_logoff,0); end; procedure TForm1.btnRebootClick(Sender: TObject); var st : SYSTEMTIME; hToken : THANDLE; tkp : TOKEN_PRIVILEGES; rr : Dword; begin OpenProcessToken(GetCurrentProcess(),TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,hToken); LookupPrivilegeValue(nil,'SeShutdownPrivilege',tkp.Privileges[0].Luid); // 设定权限为1 tkp.PrivilegeCount := 1; tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED; // 得到权限 AdjustTokenPrivileges(hToken, FALSE, tkp, 0,nil,rr); // 重起计算机 ExitWindowsEx(EWX_REBOOT , 0) end; procedure TForm1.btnCloseClick(Sender: TObject); begin // exitwindowsex(ewx_shutdown,0); Formclose.Show; end; procedure TForm1.CheckBox1Click(Sender: TObject); begin if checkbox1.Checked=true then begin checkbox2.Checked:=false; checkbox3.Checked:=false; end ; end; procedure TForm1.CheckBox2Click(Sender: TObject); begin if checkbox2.Checked=true then begin checkbox1.Checked:=false; checkbox3.Checked:=false; end; end; procedure TForm1.CheckBox3Click(Sender: TObject); begin if checkbox3.Checked=true then begin checkbox2.Checked:=false; checkbox1.Checked:=false; end; end; procedure TForm1.Timer1Timer(Sender: TObject); var hcurrentWindow:HWnd; szText:array[0..254] of char; Gamefile:TextFile; // 文本文件,存放已经知道的游戏句柄 s:string; // i,j:integer; st:SYSTEMTIME; hToken:THANDLE; tkp:TOKEN_PRIVILEGES; RR:Dword; begin try if form3.Showing=true then begin form3.Close; end; memo1.Clear; hCurrentWindow:=GetWindow(Handle,GW_HWNDFIRST); While hCurrentWindow<>0 do begin if GetWindowText(hCurrentWindow,@szText,255)>0 then Memo1.Lines.Add(strpas(@sztext)+Datetimetostr(now)); // for i:=0 to 254 do // begin try FilePath := ExtractFilePath(Application.ExeName); // 程序运行后,自动获取Game.txt的路径 assignfile(Gamefile,FilePath+'\game.txt'); // 准备读取game.txt中的信息 reset(Gamefile); except showmessage('^_^'); end; while not eof(Gamefile) do begin readln(Gamefile,s); if strPas(@szText)=s then begin form3.Show; // 发现游戏后,分别处理 if checkbox1.Checked=true then begin sendMessage(hCurrentWindow,WM_CLOSE,0,0); // 关闭游戏 end; if checkbox3.Checked=true then // 关闭计算机 begin openProcessToken(GetCurrentProcess(),TOKEN_ADJUST_PRIVILEGES OR TOKEN_QUERY,hToken); LookupPrivilegeValue(nil,'SeShutdownPrivilege',tkp.Privileges[0].Luid); tkp.privilegecount:=1; tkp.privileges[0].Attributes:=se_privilege_enabled; adjusttokenprivileges(hToken,false,tkp,0,nil,rr); exitwindowsex(ewx_poweroff,0); end; if checkbox2.Checked=true then begin exitwindowsex(ewx_force,0); // 注销计算机 end; end; end; // end; hcurrentwindow:=getwindow( hCurrentWindow,gw_hwndnext); end; finally end; end; procedure TForm1.N1Click(Sender: TObject); var p:pchar; //指针,指向将被打开的帮助文件 begin p:=pchar(ExtractFilePath(Application.ExeName)+'Help.chm'); shellexecute(0,nil,p,nil,nil,SW_NORMAL); end; end. unit Unit2; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,registry,xpWindow; type TFormclose = class(TForm) GroupBox1: TGroupBox; Label1: TLabel; Edit1: TEdit; Button1: TButton; xpWindow1: TxpWindow; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Formclose: TFormclose; implementation uses Unit1; {$R *.dfm} // 自定义过程,用于程序运行后,屏蔽操作系统的任务管理器 procedure DisableTaskmgr(Key: Boolean); Var Reg:TRegistry; Begin Reg:=TRegistry.Create; try Reg.RootKey := HKEY_CURRENT_USER; if Reg.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Policies\System', True) then begin if Key then Reg.WriteString('DisableTaskMgr','1') else Reg.WriteInteger('DisableTaskMgr',0); Reg.CloseKey; end; except Reg.Free; end; end; // 自定义过程,实现系统开机自动运行 procedure SetAuttorun(aProgTitle,aCmdLine:string;aRunOnce:boolean); var hKey:string; hReg:TRegIniFile; begin if aRunOnce then hKey:='Once' else hKey:=''; hReg:=TRegIniFile.Create(''); hReg.RootKey:=HKEY_LOCAL_MACHINE; hReg.WriteString('software\microsoft\windows\currentversion\run' +hKey+#0,aProgTitle,aCmdLine); // 修改操作系统注册表 hReg.Destroy; end; procedure TFormclose.Button1Click(Sender: TObject); var key:boolean; begin if edit1.Text='162534' then begin key:=false; DisableTaskmgr(key); // 当系统推出时恢复任务管理器 application.Terminate; end else begin showmessage('密码错误!'); formclose.Close; end; edit1.Clear; end; end.
一、临界区 所谓临界区,就是一次只能由一个线程来执行的一段代码。如果把初始化数组的代码放在临界区内,另一个线程在第一个线程处理完之前是不会被执行的。 使用临界区的步骤: 1、先声明一个全局变量类型为TRTLCriticalSection; 2、在线程Create()前调用InitializeCriticalSection()过程来初始化,该函数定义是: void WINAPI InitializeCriticalSection(LPCRITICAL_SECTION lpCriticalSection); 类型lpCriticalSection即是Delphi封装的TRTLCriticalSection。 3、在线程的需要放入临界区的代码前面使用EnterCriticalSection(lpCriticalSection)过程来开始建立临界区。在代码完成后用LeaveCriticalSection(lpCriticalSection)来标志临界区的结束。 4、在线程执行完后用DeleteCriticalSection(lpCriticalSection)来清除临界区。这个清除过程必须放在线程执行完后的地方,比如FormDesroy事件中。上面的例子中,若把该过程放在TMyThread.Create(False);后,会产生错误。 二、互斥: 互斥非常类似于临界区,除了两个关键的区别:首先,互斥可用于跨进程的线程同步。其次,互斥能被赋予一个字符串名字,并且通过引用此名字创建现有互斥对象的附加句柄。 提示临界区与事件对象(比如互斥对象)的最大的区别是在性能上。临界区在没有线程冲突时,要用10~15个时间片,而事件对象由于涉及到系统内核要用400~600个时间片。 使用互斥的步骤: 1、声明一个类型为Thandle或Hwnd的全局变量,其实都是Cardinal类型。Hwnd是handle of window,主要用于窗口句柄;而Thandle则没有限制。 2、线程Create()前用CreateMutex()来创建一个互斥量。该函数定义为: HANDLE WINAPI CreateMutex( LPSECURITY_ATTRIBUTES lpMutexAttributes, BOOL bInitialOwner, LPCTSTR lpName:Pchar); LPSECURITY_ATTRIBUTES参数为一个指向TSecurityAttributtes记录的指针。此参数设为nil,表示访问控制列表默认的安全属性。 bInitalOwner参数表示创建互斥对象的线程是否要成为此互斥对象的拥有者。当此参数为False时,表示互斥对象没有拥有者。 lpName参数指定互斥对象的名称。设为nil表示无命名,如果参数不是设为nil,函数会搜索是否有同名的互斥对象存在。如果有,函数就会返回同名互斥对象的句柄。否则,就新创建一个互斥对象并返回其句柄。 返回值是一handle。当错误发生时,返回null,此时用GetLastError函数可查看错误的信息。 利用CreateMutex()可以防止程序多个实例运行,如下例: Program ABC; Uses Forms,Windows,…; {$R *.res} Var hMutex:Hwnd; Begin Application.Initialize; hMutex:=CreateMutex(nil,False,Pchar(Application.Title)); if GetLastErrorERROR_ALREADY_EXISTS then begin //项目要运行的咚咚 end; ReleaseMutex(hMutex); Application.Run; End; 在本节的例程中,我们只是要防止线程进入同步代码区域中,所以lpName参数设置为nil。 3、在同步代码前用WaitForSingleObject()函数。该函数使得线程取得互斥对象(同步代码)的拥有权。该函数定义为: DWORD WINAPI WaitForSingleObject( HANDLE hHandle, DWORD dwMilliseconds); 这个函数可以使当前线程在dwMilliseconds指定的时间内睡眠,直到hHandle参数指定的对象进入发信号状态为止。一个互斥对象不再被线程拥有时,它就进入发信号状态。当一个进程要终止时,它就进入发信号状态。dwMilliseconds参数可以设为0,这意味着只检查hHandle参数指定的对象是否处于发信号状态,而后立即返回。dwMilliseconds参数设为INFINITE,表示如果信号不出现将一直等下去。 这个函数的返回值含义: WAIT_ABANDONED 指定的对象是互斥对象,并且拥有这个互斥对象的线程在没有释放此对象之前就已终止。此时就称互斥对象被抛弃。这种情况下,这个互斥对象归当前线程所有,并把它设为非发信号状态 WAIT_OBJECT_0 指定的对象处于发信号状态 WAIT_TIMEOUT 等待的时间已过,对象仍然是非发信号状态 再次声明,当一个互斥对象不再被一个线程所拥有,它就处于发信号状态。此时首先调用WaitForSingleObject()函数的线程就成为该互斥对象的拥有者,此互斥对象设为不发信号状态。当线程调用ReleaseMutex()函数并传递一个互斥对象的句柄作为参数时,这种拥有关系就被解除,互斥对象重新进入发信号状态。 注意除WaitForSingleObject()函数外,你还可以使用WaitForMultipleObject()和MsgWaitForMultipleObject()函数,它们可以等待几个对象变为发信号状态。这两个函数的详细情况请看Win32 API联机文档。 4、在同步代码结束后,使用ReleaseMutex(THandle)函数来标志。该函数只是释放互斥对象和线程的拥有者关系,并不释放互斥对象的句柄。 5、调用CloseHandle(THandle)来关闭互斥对象。请注意例程中该函数的使用位置。 三、还有一种用信号量对象来管理线程同步的,它是在互斥的基础上建立的,但信号量增加了资源计数的功能,预定数目的线程允许同时进入要同步的代码。有点复杂,想不到在哪可以用,现在就不研究论了。 unit Tst_Thread3U; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, StdCtrls; type TForm1 = class(TForm) Button1: TButton; Memo1: TMemo; Button2: TButton; Button3: TButton; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); private procedure ThreadsDone(Sender: TObject); end; TMyThread=class(TThread) protected procedure Execute;override; end; var Form1: TForm1; implementation {$R *.dfm} const MaxSize=128; var NextNumber:Integer=0; DoneFlags:Integer=0; GlobalArry:array[1..MaxSize] of Integer; Lock:byte; //1-不同步 2-临界区 3-互斥 CS:TRTLCriticalSection; //临界区 hMutex:THandle; //互斥 function GetNextNumber:Integer; begin Result:=NextNumber; inc(NextNumber); end; procedure TMyThread.Execute; var i:Integer; begin FreeOnTerminate:=True; //终止后自动free OnTerminate:=Form1.ThreadsDone; if Lock3 then //非互斥情况 begin if Lock=2 then EnterCriticalSection(CS); //建立临界区 for i := 1 to MaxSize do begin GlobalArry[i]:=GetNextNumber; Sleep(5); end; if Lock=2 then LeaveCriticalSection(CS);//离开临界区 end else //-------互斥 begin if WaitForSingleObject(hMutex,INFINITE)=WAIT_OBJECT_0 then begin for i := 1 to MaxSize do begin GlobalArry[i]:=GetNextNumber; Sleep(5); end; end; ReleaseMutex(hMutex); //释放 end; end; procedure TForm1.ThreadsDone(Sender: TObject); var i:Integer; begin Inc(DoneFlags); if DoneFlags=2 then begin for i := 1 to MaxSize do Memo1.Lines.Add(inttostr(GlobalArry[i])); if Lock=2 then DeleteCriticalSection(CS); //删除临界区 If Lock=3 then CloseHandle(hMutex); //关闭互斥 end; end; //非同步 procedure TForm1.Button1Click(Sender: TObject); begin Lock:=1; TMyThread.Create(False); TMyThread.Create(False); end; //临界区 procedure TForm1.Button2Click(Sender: TObject); begin Lock:=2; InitializeCriticalSection(CS); //初始化临界区 TMyThread.Create(False); TMyThread.Create(False); end; //互斥 procedure TForm1.Button3Click(Sender: TObject); begin Lock:=3; // 互斥 hMutex:=CreateMutex(0,False,nil); TMyThread.Create(False); TMyThread.Create(False); end; end.
您查询的关键词是:delphi 同步 数据 。如果打开速度慢,可以尝试快速版;如果想保存快照,可以添加到搜藏。 (百度和网页http://blog.csdn.net/mygodsos/archive/2008/10/19/3097921.aspx的作者无关,不对其内容负责。百度快照谨为网络故障时之索引,不代表被搜索网站的即时页面。) -------------------------------------------------------------------------------- 发呆茶馆 登录 注册 欢迎 退出 我的博客 配置 写文章 文章管理 博客首页 全站 当前博客 空间 博客 好友 相册 留言 用户操作 [发私信] [加为好友] mygodsos 订阅我的博客 mygodsos的公告 文章分类 Delphi Delphi学习--多线程 Delphi学习--自创的常用函数 期货大事记 生活感悟 投资理财 编程学习 万一的Delphi博客 存档 2009年05月(3) 2008年11月(13) 2008年10月(8) 2008年09月(3) ◆Delphi多线程编程之三 同步读写全局数据 ◆(乌龙哈里2008-10-12) 收藏 ◆Delphi多线程编程之三同步读写全局数据 ◆(乌龙哈里2008-10-12) (调试环境:Delphi2007+WinXPsp3 例程:Tst_Thread3.dpr) 开始研究最重要的多线程读写全局数据了,结合书上的例子,我修改成下面的情况: unit Tst_Thread3U; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, StdCtrls; type TForm1 = class(TForm) Button1: TButton; Memo1: TMemo; Button2: TButton; Button3: TButton; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); private procedure ThreadsDone(Sender: TObject); end; TMyThread=class(TThread) protected procedure Execute;override; end; var Form1: TForm1; implementation {$R *.dfm} const MaxSize=128; var NextNumber:Integer=0; DoneFlags:Integer=0; GlobalArry:array[1..MaxSize] of Integer; Lock:byte; //1-不同步 2-临界区 3-互斥 CS:TRTLCriticalSection; //临界区 hMutex:THandle; //互斥 function GetNextNumber:Integer; begin Result:=NextNumber; inc(NextNumber); end; procedure TMyThread.Execute; var i:Integer; begin FreeOnTerminate:=True; //终止后自动free OnTerminate:=Form1.ThreadsDone; if Lock3 then //非互斥情况 begin if Lock=2 then EnterCriticalSection(CS); //建立临界区 for i := 1 to MaxSize do begin GlobalArry[i]:=GetNextNumber; Sleep(5); end; if Lock=2 then LeaveCriticalSection(CS);//离开临界区 end else //-------互斥 begin if WaitForSingleObject(hMutex,INFINITE)=WAIT_OBJECT_0 then begin for i := 1 to MaxSize do begin GlobalArry[i]:=GetNextNumber; Sleep(5); end; end; ReleaseMutex(hMutex); //释放 end; end; procedure TForm1.ThreadsDone(Sender: TObject); var i:Integer; begin Inc(DoneFlags); if DoneFlags=2 then begin for i := 1 to MaxSize do Memo1.Lines.Add(inttostr(GlobalArry[i])); if Lock=2 then DeleteCriticalSection(CS); //删除临界区 If Lock=3 then CloseHandle(hMutex); //关闭互斥 end; end; //非同步 procedure TForm1.Button1Click(Sender: TObject); begin Lock:=1; TMyThread.Create(False); TMyThread.Create(False); end; //临界区 procedure TForm1.Button2Click(Sender: TObject); begin Lock:=2; InitializeCriticalSection(CS); //初始化临界区 TMyThread.Create(False); TMyThread.Create(False); end; //互斥 procedure TForm1.Button3Click(Sender: TObject); begin Lock:=3; // 互斥 hMutex:=CreateMutex(0,False,nil); TMyThread.Create(False); TMyThread.Create(False); end; end. 没有临界区和互斥的帮助,两个线程都不断地在Memo1输出,而且数字是乱的。 一、临界区 所谓临界区,就是一次只能由一个线程来执行的一段代码。如果把初始化数组的代码放在临界区内,另一个线程在第一个线程处理完之前是不会被执行的。 使用临界区的步骤: 1、先声明一个全局变量类型为TRTLCriticalSection; 2、在线程Create()前调用InitializeCriticalSection()过程来初始化,该函数定义是: void WINAPI InitializeCriticalSection(LPCRITICAL_SECTION lpCriticalSection); 类型lpCriticalSection即是Delphi封装的TRTLCriticalSection。 3、在线程的需要放入临界区的代码前面使用EnterCriticalSection(lpCriticalSection)过程来开始建立临界区。在代码完成后用LeaveCriticalSection(lpCriticalSection)来标志临界区的结束。 4、在线程执行完后用DeleteCriticalSection(lpCriticalSection)来清除临界区。这个清除过程必须放在线程执行完后的地方,比如FormDesroy事件中。上面的例子中,若把该过程放在TMyThread.Create(False);后,会产生错误。 二、互斥: 互斥非常类似于临界区,除了两个关键的区别:首先,互斥可用于跨进程的线程同步。其次,互斥能被赋予一个字符串名字,并且通过引用此名字创建现有互斥对象的附加句柄。 提示临界区与事件对象(比如互斥对象)的最大的区别是在性能上。临界区在没有线程冲突时,要用10~15个时间片,而事件对象由于涉及到系统内核要用400~600个时间片。 使用互斥的步骤: 1、声明一个类型为Thandle或Hwnd的全局变量,其实都是Cardinal类型。Hwnd是handle of window,主要用于窗口句柄;而Thandle则没有限制。 2、线程Create()前用CreateMutex()来创建一个互斥量。该函数定义为: HANDLE WINAPI CreateMutex( LPSECURITY_ATTRIBUTES lpMutexAttributes, BOOL bInitialOwner, LPCTSTR lpName:Pchar); LPSECURITY_ATTRIBUTES参数为一个指向TSecurityAttributtes记录的指针。此参数设为nil,表示访问控制列表默认的安全属性。 bInitalOwner参数表示创建互斥对象的线程是否要成为此互斥对象的拥有者。当此参数为False时,表示互斥对象没有拥有者。 lpName参数指定互斥对象的名称。设为nil表示无命名,如果参数不是设为nil,函数会搜索是否有同名的互斥对象存在。如果有,函数就会返回同名互斥对象的句柄。否则,就新创建一个互斥对象并返回其句柄。 返回值是一handle。当错误发生时,返回null,此时用GetLastError函数可查看错误的信息。 利用CreateMutex()可以防止程序多个实例运行,如下例: Program ABC; Uses Forms,Windows,…; {$R *.res} Var hMutex:Hwnd; Begin Application.Initialize; hMutex:=CreateMutex(nil,False,Pchar(Application.Title)); if GetLastErrorERROR_ALREADY_EXISTS then begin //项目要运行的咚咚 end; ReleaseMutex(hMutex); Application.Run; End; 在本节的例程中,我们只是要防止线程进入同步代码区域中,所以lpName参数设置为nil。 3、在同步代码前用WaitForSingleObject()函数。该函数使得线程取得互斥对象(同步代码)的拥有权。该函数定义为: DWORD WINAPI WaitForSingleObject( HANDLE hHandle, DWORD dwMilliseconds); 这个函数可以使当前线程在dwMilliseconds指定的时间内睡眠,直到hHandle参数指定的对象进入发信号状态为止。一个互斥对象不再被线程拥有时,它就进入发信号状态。当一个进程要终止时,它就进入发信号状态。dwMilliseconds参数可以设为0,这意味着只检查hHandle参数指定的对象是否处于发信号状态,而后立即返回。dwMilliseconds参数设为INFINITE,表示如果信号不出现将一直等下去。 这个函数的返回值含义: WAIT_ABANDONED 指定的对象是互斥对象,并且拥有这个互斥对象的线程在没有释放此对象之前就已终止。此时就称互斥对象被抛弃。这种情况下,这个互斥对象归当前线程所有,并把它设为非发信号状态 WAIT_OBJECT_0 指定的对象处于发信号状态 WAIT_TIMEOUT 等待的时间已过,对象仍然是非发信号状态 再次声明,当一个互斥对象不再被一个线程所拥有,它就处于发信号状态。此时首先调用WaitForSingleObject()函数的线程就成为该互斥对象的拥有者,此互斥对象设为不发信号状态。当线程调用ReleaseMutex()函数并传递一个互斥对象的句柄作为参数时,这种拥有关系就被解除,互斥对象重新进入发信号状态。 注意除WaitForSingleObject()函数外,你还可以使用WaitForMultipleObject()和MsgWaitForMultipleObject()函数,它们可以等待几个对象变为发信号状态。这两个函数的详细情况请看Win32 API联机文档。 4、在同步代码结束后,使用ReleaseMutex(THandle)函数来标志。该函数只是释放互斥对象和线程的拥有者关系,并不释放互斥对象的句柄。 5、调用CloseHandle(THandle)来关闭互斥对象。请注意例程中该函数的使用位置。 三、还有一种用信号量对象来管理线程同步的,它是在互斥的基础上建立的,但信号量增加了资源计数的功能,预定数目的线程允许同时进入要同步的代码。有点复杂,想不到在哪可以用,现在就不研究论了。 发表于 @ 2008年10月19日 00:47:00 | 评论( loading... ) | 编辑| 举报| 收藏 旧一篇:◆delphi多线程编程之二 ◆(乌龙哈里2008-10-12) | 新一篇:◆Delphi多线程编程之四 线程安全和VCL ◆(乌龙哈里2008-10-12)Csdn Blog version 3.1a Copyright © mygodsos

5,390

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 开发及应用
社区管理员
  • VCL组件开发及应用社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧