运行出错,给出源程序。调了无数小时也不知道错在那里啊。高手帮忙解决!

chinadragonss 2003-11-10 08:29:01
本程序是监视某目录变化,若有就打开两个模式对话框。在线程或资源释放上存在问题。运行出现地址访问错误。请帮忙看看原因,或给出改进方案。

源程序如下:
unit Unit1;

interface

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

const
WM_FileChanged = WM_USER + 101;
WM_CloseForm = WM_USER + 102;

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
FWatchThread: TThread;
FShowThread: TThread;
public
{ Public declarations }
procedure DoFileChange(var Msg: TMessage); message WM_FileChanged;
procedure DoCloseForm(var Msg: TMessage); message WM_CloseForm;
end;

var
Form1: TForm1;
i : integer;

implementation
uses unit3,unit4;
{$R *.dfm}

procedure TForm1.DoFileChange(var Msg: TMessage);
begin

FShowThread.Resume;

end;

procedure TForm1.DoCloseForm(var Msg: TMessage);
begin
if FshowThread.Suspended = false then
FShowThread.Suspend;
if form3 <> nil then
begin
form4.closeForm;
form3.closeform;
end;
if (form3 <> nil) or (form4 <> nil) then
showmessage('error!!');
if (form3 = nil) and (form4 = nil) then
i := 1;



end;

procedure TForm1.Button1Click(Sender: TObject);
begin
FWatchThread := FileWatch.Create(false);
button1.Enabled := false;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
FShowThread := FShow.Create(true);
i := 0;
end;

end.

unit Unit2;

interface

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


type
FileWatch = class(TThread)
private
{ Private declarations }
FDirectoryHandle: THandle;
FNotificationBuffer: array[0..4096] of Byte;
FBytesWritten: DWORD;
protected
procedure Execute; override;
procedure getChangeFileName;
end;

const
FILE_LIST_DIRECTORY = $0001;



type
PFileNotifyInformation = ^TFileNotifyInformation;
TFileNotifyInformation = record
NextEntryOffset: DWORD;
Action: DWORD;
FileNameLength: DWORD;
FileName: array[0..0] of WideChar;
end;

var
FileName: string;
implementation
uses unit1,unit3,unit4;

procedure FileWatch.getChangeFileName;
var
FileOpNotification: PFileNotifyInformation;

begin
Pointer(FileOpNotification) := @FNotificationBuffer[0];
FileName := WideCharToString(@(FileOpNotification^.FileName));

sendmessage(Form1.Handle,WM_CloseForm,0,0);
showMessage('there has new file ');
repeat
until i = 1;
i := 0;

//application.ProcessMessages;
//showMessage('there has new file ');
postmessage(Form1.Handle,WM_FileChanged,0,0);
application.ProcessMessages;
ZeroMemory(@FNotificationBuffer, SizeOf(FNotificationBuffer));


end;

procedure FileWatch.Execute;
begin

FDirectoryHandle := CreateFile('f:\java',
FILE_LIST_DIRECTORY,
FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE,
nil,
OPEN_EXISTING,
FILE_FLAG_BACKUP_SEMANTICS or FILE_FLAG_OVERLAPPED,
0);

if FDirectoryHandle = INVALID_HANDLE_VALUE then
begin
FDirectoryHandle := 0;
ShowMessage(SysErrorMessage(GetLastError));
exit;
end;
ZeroMemory(@FNotificationBuffer, SizeOf(FNotificationBuffer));
FBytesWritten := 0;
while ReadDirectoryChanges(FDirectoryHandle, @FNotificationBuffer, SizeOf(FNotificationBuffer), false, FILE_NOTIFY_CHANGE_FILE_NAME, @FBytesWritten, nil, nil) do
begin
//Synchronize(getChangeFileName);
getChangeFileName;

end;
end;

end.

unit Unit3;

interface

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

type
TForm3 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormDestroy(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
{ Private declarations }
public
{ Public declarations }
procedure closeForm;
end;

var
Form3: TForm3;

implementation

{$R *.dfm}

procedure TForm3.closeForm;
begin

self.free;
end;
procedure TForm3.Button1Click(Sender: TObject);
begin
close;
end;

procedure TForm3.Button2Click(Sender: TObject);
begin
try
begin
form4 := TForm4.Create(self);
form4.showmodal;
end
finally
if form4 <> nil then
begin
form4.Free;
form4 := nil;
end;
end;
end;

procedure TForm3.FormClose(Sender: TObject; var Action: TCloseAction);
begin
showmessage('form3 is closeing');
end;

procedure TForm3.FormDestroy(Sender: TObject);
begin
showmessage('form3 is destory');
form3 := nil;
end;

procedure TForm3.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose := true;

end;

end.

unit Unit4;

interface

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

type
TForm4 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
{ Private declarations }
public
{ Public declarations }
procedure closeForm;
end;

var
Form4: TForm4;

implementation

{$R *.dfm}

procedure Tform4.closeForm;
begin

self.free;
end;

procedure TForm4.Button1Click(Sender: TObject);
begin
close;
end;

procedure TForm4.FormDestroy(Sender: TObject);
begin
showmessage(' form4 is destory');
form4 := nil;
end;

procedure TForm4.FormClose(Sender: TObject; var Action: TCloseAction);
begin
showmessage('form4 is closing');
end;

procedure TForm4.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose := true;
application.ProcessMessages;
end;

end.

unit Unit5;

interface

uses
Classes,unit3,unit4;

type
FShow = class(TThread)
private
{ Private declarations }
protected
procedure Execute; override;

end;

implementation

{ Important: Methods and properties of objects in visual components can only be
used in a method called using Synchronize, for example,

Synchronize(UpdateCaption);

and UpdateCaption could look like,

procedure FShow.UpdateCaption;
begin
Form1.Caption := 'Updated in a thread';
end; }

{ FShow }

procedure FShow.Execute;
begin
if form3 <> nil then
begin
if form4 <> nil then
begin
form4.free;
form4 := nil;
end;
form3.Free;
form3 := nil;
end;
try
begin
form3 := TForm3.Create(form3);
form3.Showmodal;
end
finally
if form3 <> nil then
begin
form3.Free;
form3 := nil;
end;
end;
end;

end.
...全文
40 15 打赏 收藏 转发到动态 举报
写回复
用AI写文章
15 条回复
切换为时间正序
请发表友善的回复…
发表回复
BoningSword 2003-11-11
  • 打赏
  • 举报
回复
你的根本的问题是整个程序上设计有问题的,觉得兜很多弯路干那么点事.
要不你把程序的目的说一下,就你目前的程序说老实的不是很想看,太乱,不合理.
chinadragonss 2003-11-11
  • 打赏
  • 举报
回复
我现在就要解决的是有新文件来了,显示form3,for4。 当时form3,form4正在显示中,如果又有新文件检测到,则先关闭form3,fom4。然后在显示form3,form4.很简单。上面程序的问题在哪里呢
chinadragonss 2003-11-11
  • 打赏
  • 举报
回复
有谁发现错误了吗?这个程序监视文件变化那一块也没有问题。只是在适时读出变化
文件的内容时存在问题。能检测到文件变化,但是在显示from3,form4时就不行了。
aiirii 2003-11-11
  • 打赏
  • 举报
回复
>>你的根本的问题是整个程序上设计有问题的,觉得兜很多弯路干那么点事.
同意!!
wzwcn 2003-11-11
  • 打赏
  • 举报
回复
up吧
chinadragonss 2003-11-10
  • 打赏
  • 举报
回复
好,把源代码发给你了。请查收。 错误是在线程配合上
问题在showthread线程。
BoningSword 2003-11-10
  • 打赏
  • 举报
回复
在那段代码出错?
form3 := TForm3.Create(nil);//试试这个.
愿意的话把源代码发给我玩玩,晚上下班帮你看看,现在没时间.
huangh@scitel.com.cn
yudehui 2003-11-10
  • 打赏
  • 举报
回复
学习
加强学习


巨寒
chinadragonss 2003-11-10
  • 打赏
  • 举报
回复
はは、debug n久拉。 代码很简单啊。只是一个模型。运行会出现地址访问错误。
如果把showmodal 改成 show的话,运行出错概率大减,但是会出错。不知道为何

Forllx 2003-11-10
  • 打赏
  • 举报
回复
太长,没心情看,你应该先debug一下,找出出错点,再问好一点点,
帮你up一下
BoningSword 2003-11-10
  • 打赏
  • 举报
回复
http://www.vclxx.org/DELPHI/D32SAMPL/DIRMON.ZIP
这个例子在网上流传很广,运行的很好的,你把它下了看看,很简单的.
BoningSword 2003-11-10
  • 打赏
  • 举报
回复
要不你说说你程序的目的,我抽空给你写个简单的demo,怎么样.
chinadragonss 2003-11-10
  • 打赏
  • 举报
回复
还有这会和showmodal ,show 有关系吗? 为何改成show就出错很少。
chinadragonss 2003-11-10
  • 打赏
  • 举报
回复
to BoningSword.
多谢。不过我在以前就是没有fshow线程,就是doFileChange里做的,但也会出现奇怪错误。
地址不能访问。form3,form4 只是一个例子罢了。其实它是根据新文件实时查询数据库,显示信息。
你说的线程终止,指那个文件监视线程不能终止吧。
BoningSword 2003-11-10
  • 打赏
  • 举报
回复
我看了一下你的程序,FShow线程是多余的,而且在这个线程里面你不能执行form3.Showmodal
或者form3.Show工作,所以会出错!这是因为在线程里面都不能直接调用主线程的资源,而所有的
GUI资源都属于主线程的.

你把FShow的工作都放在主线程的DoFileChange事件就可以了.另外还要注意线程的终止.
另外,和主线程通讯推荐在线程里用Synchronize()函数,不推荐用消息方式.

其实你这个功能实现很简单,但似乎多加了form3和form4是没必要的.现在没时间,晚上有时间
再详细看看.ENJOY!

1,183

社区成员

发帖
与我相关
我的任务
社区描述
Delphi Windows SDK/API
社区管理员
  • Windows SDK/API社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

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