运行时线程访问冲突错误

Question

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

接下来，我使用 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

但是第二次，当我的表被保存时，就没有问题了。

注意：尽管这段代码让我很恼火，但该应用程序的工作原理是一样的 另一件事我不知道当文件夹很大时如何停止线程。我关闭了停止的应用程序。

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