运行出错,给出源程序。调了无数小时也不知道错在那里啊。高手帮忙解决!
本程序是监视某目录变化,若有就打开两个模式对话框。在线程或资源释放上存在问题。运行出现地址访问错误。请帮忙看看原因,或给出改进方案。
源程序如下:
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.