multithreading - 运行时线程访问冲突错误
问题描述
我的想法是从字符串列表中的文件夹和子文件夹中下载所有文件。
接下来,我使用该SHGetFileInfo
函数检索名称并从文件中键入日期和链接以加载到我的 Access 数据库中。
我的应用程序工作正常,但是当我使用包含数百个文件的大文件夹时,它会阻止我使用线程所需的内容。
当我使用线程并且我的表为空时,它会显示错误消息,但是当我的表第二次包含记录时它显示没有问题。
搜索程序
procedure FileSearche(const PathName: string; var lstFiles: TStringList);
const
FileMask = '*.*';
var
Rec: TSearchRec;
Path: string;
begin
Path := IncludeTrailingBackslash(PathName);
if FindFirst(Path + FileMask, faAnyFile - faDirectory, Rec) = 0 then
try
repeat
lstFiles.Add(Path + Rec.Name);
until FindNext(Rec) <> 0;
finally
FindClose(Rec);
end;
if FindFirst(Path + '*.*', faDirectory, Rec) = 0 then
try
repeat
if ((Rec.Attr and faDirectory) <> 0) and (Rec.Name <> '.') and
(Rec.Name <> '..') then
FileSearche(Path + Rec.Name, lstFiles);
until FindNext(Rec) <> 0;
finally
FindClose(Rec);
end;
end;
线程的过程
//--------------------------------------------------------------
{ debloc }
procedure debloc.execute;
var
icn: HICON;
SHFileInfo: TSHFileInfo;
SearchRecord: TSearchRec;
Size, I: Integer;
lstFiles: TStringList;
State: SHELLSTATE;
lien, path: string;
isEmpty : boolean;
begin
// to request windows to display the extension of all files
SHGetSetSettings(State, SSF_SHOWEXTENSIONS, false);
State.Data := State.Data or SSF_SHOWEXTENSIONS;
SHGetSetSettings(State, SSF_SHOWEXTENSIONS, True);
SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_FLUSHNOWAIT, nil, nil);
// for select folder
if SelectDirectory('Choisi un dossier ', ' ', path) then
Lien := IncludeTrailingPathDelimiter(path) else exit;
isEmpty := IsDirectoryEmpty(path) ;
// To verify that the folder is not empty
if isEmpty = false then
Begin
if MessageDlg('Remarque Le dossier :'+#13+path +#13+'est vide il n y pas des fichiers à importer', mtInformation,
[mbOK], 0, mbOK) = mrOk then
exit;
End;
// To verify that the folder is not folder systeme
if
(Lien = IncludeTrailingPathDelimiter(SpecialFolder(CSIDL_WINDOWS)))
or (Lien = IncludeTrailingPathDelimiter(SpecialFolder(CSIDL_SYSTEM)))
or (Lien = IncludeTrailingPathDelimiter(SpecialFolder(CSIDL_PROGRAM_FILES)))
or (Lien = IncludeTrailingPathDelimiter(SpecialFolder(CSIDL_PROGRAM_FILESX86)))
or (Lien = IncludeTrailingPathDelimiter(SpecialFolder(CSIDL_MYPICTURES)))
or (Lien = IncludeTrailingPathDelimiter(SpecialFolder(CSIDL_PROGRAM_FILES_COMMONX86)))
or (Lien = 'C:\')
then
begin
// ShowMessage(Lien+#13+'Erro, Les dossiers système sont ignoré pour votre sécurité');
if MessageDlg(Lien+#13+'Attention, Pour des raison de sécurité les dossiers système sont ignoré ', mtWarning,
[mbYes], 0, mbYes) = mrYes then
exit;
end
else
begin
//To list the files in the StringList
begin
lstFiles := TStringList.Create;
FileSearche(lien, lstFiles);
end;
if lstFiles.Count > 0 then
for I := 0 to lstFiles.Count - 1 do
begin
//To get the name, type, date, links of all files
SHGetFileInfo(PChar(lstFiles[I]), 0, SHFileInfo, SizeOf(TSHFileInfo),
SHGFI_TYPENAME or SHGFI_DISPLAYNAME or SHGFI_SYSICONINDEX or
SHGFI_ICON);
FindFirst(lstFiles[I], 0, SearchRecord);
Size := SearchRecord.Size;
//To fill the Field of the table
Form1.FDTable1.Edit;
Form1.FDTable1.Insert;
Form1.FDTable1.FieldByName('nom_file').ASSTRING := (SHFileInfo.szDisplayName);
Form1.FDTable1.FieldByName('type_file').ASSTRING := (SHFileInfo.szTypeName);
Form1.FDTable1.FieldByName('size_file').ASSTRING := (GetFileSizeAsString(Size));
Form1.FDTable1.FieldByName('date_time_file').ASSTRING :=
(DateTimeToStr(FileDateToDateTime(SearchRecord.Time)));
Form1.FDTable1.FieldByName('lien_file').ASSTRING :=
(ExtractFilePath(lstFiles[I]));
Form1.ProgressBar1.Max := Form1.FDTable1.RecordCount;
Form1.ProgressBar1.Position := Form1.FDTable1.RecordCount;
end ;
Form1.FDTable1.Post;
Form1.FDTable1.First;
Form1.StatusBar1.Panels[0].Text := 'Nombre d"enregistrements: ' +
IntToStr(Form1.FDTable1.RecordCount);
// to request windows to hide the extension of all files
SHGetSetSettings(State, SSF_SHOWEXTENSIONS, false);
State.Data := State.Data and ($FFFFFFFF xor SSF_SHOWEXTENSIONS);
SHGetSetSettings(State, SSF_SHOWEXTENSIONS, True);
SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_FLUSHNOWAIT, nil, nil);
// procedure to rearrange the automatic columns
SetGridColumnWidths(Form1.dbgrid1);
Application.ProcessMessages;
end;
end;
执行线程
procedure TForm1.Button1Click(Sender: TObject);
BEGIN
with debloc.Create do
FreeOnTerminate:=true;
END;
当我使用线程并且表为空时,它显示错误消息
违反 d'accès à l'adresse 00732BB1
但是第二次,当我的表被保存时,这不是问题。
注意:尽管这段代码让我很恼火,但该应用程序的工作方式甚至是另一件事,我不知道当文件夹很大时如何停止线程。我关闭停止的应用程序。
解决方案
我通过用 listview 组件替换 dbgrid 组件解决了这个问题
procedure debloc.transfertdata;
var
Myitem : TListItem;
MyColumn : TListColumn;
begin
ListView1.Items.Clear;
ListView1.Columns.Clear;
MyColumn:= ListView1.Columns.Add;
MyColumn.Caption:= 'Nom' ;
MyColumn.Width := -1;
MyColumn:= ListView1.Columns.Add;
MyColumn.Caption:= 'Type' ;
MyColumn.Width := -1;
MyColumn:= ListView1.Columns.Add;
MyColumn.Caption:= 'Taille' ;
MyColumn.Width := -1;
MyColumn:= ListView1.Columns.Add;
MyColumn.Caption:= 'Date de modification' ;
MyColumn.Width := -1;
MyColumn:= ListView1.Columns.Add;
MyColumn.Caption:= 'Lien' ;
MyColumn.Width := -1;
FDTable1.First;
while not FDTable1.Eof do
begin
ListView1.Items.BeginUpdate;
Myitem := ListView1.items.Add;
Myitem.Caption:= FDTable1.FieldByName('nom_file').ASSTRING;
Myitem.SubItems.Add(FDTable1.FieldByName('type_file').ASSTRING) ;
Myitem.SubItems.Add(FDTable1.FieldByName('size_file').ASSTRING) ;
Myitem.SubItems.Add(FDTable1.FieldByName('date_time_file').ASSTRING) ;
Myitem.SubItems.Add(FDTable1.FieldByName('lien_file').ASSTRING) ;
FDTable1.Next;
ListView1.Items.EndUpdate;
end;
end;
在我添加的线程中
Synchronize(transfertdata);
推荐阅读
- flutter - 如何使用颤振安排本地通知
- java - 尝试使用 ProcessBuilder 从命令行启动服务器
- php - 如何使用 PHP Profiler 跟踪 Mysql 慢查询日志文件条目
- computer-science - 在特定时间后仅更新数组中特定项目的最佳方法是什么?
- java - JLabel 的文本在 hitbox 的中间
- python - 在哪里添加while循环以使最小值和最大值正常工作
- git - 如何使用 AWS Code Deploy 和 AWS Code Pipeline 一次部署多个 git 存储库?
- python - 如何在函数 root.destroy 之后运行代码
- activerecord - 使用关系通过和比较运算符时,Yii2 对父模型表的别名
- android - shouldShowRequestPermissionRationale 方法的工作