运行时线程访问冲突错误

Question

我的想法是从字符串列表中的文件夹和子文件夹中下载所有文件。

接下来，我使用 SHGetFileInfo 函数从文件中检索名称并键入日期和链接，以加载到我的 Access 数据库中。

我的应用程序工作正常，但是当我使用包含数百个文件的大文件夹时，它会阻止我使用线程所需的内容。

当我使用线程并且我的 table 为空时，它显示错误消息，但是第二次当我的 table 包含记录时它显示没有问题。

搜索过程

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;

当我使用线程时table为空，显示错误信息

violation d'accès à l'adresse 00732BB1

但是第二次，我的table保存的时候，就没有问题了。

注意：尽管这段代码让我很烦，但该应用程序运行正常另一件事我不知道当文件夹很大时如何停止线程。我关闭申请停止。

Answer 1

我通过将 dbgrid 组件替换为 listview 组件解决了问题

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);

运行时线程访问冲突错误

Runtime Thread Access Violation Errors

multithreading

delphi-2010