Вставка имени из Filelistbox в Edit в тему письма, копирование и удаление файлов

@Eirstrean · Регистрация: 17.03.2019

Студворк — интернет-сервис помощи студентам

Всем привет, в программе по отправке сообщений возникло пару вопросов, к сожалению, пытался найти решение, но так и не понял как сделать это с тем, что у меня есть. Если есть возможность подскажите как правильно, или предложите свой вариант.
Windows 7 - 64
Delphi 10.4

1. Идея в том, что в папке "Рапорта" есть файл с названием и расширением "СТАВ-2132.doсx"
Из Filelistbox берутся данные по найденным файлам с определенными расширениями и добавляются в тему письма в EDIT.
Получается так: "Сообщение СТАВ-2132.doсx"
К сожалению, когда файлов 2 и более, тема получается такая "Сообщение СТАВ-2132.doсxСУП-2333.doc"

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
 
//  --------------------------------------------------------
// Проверяет файлы прикрепленные к письму и добавляет их имена (ДОРАБОТАТЬ)
// --------------------------------------------------------
  Filelistbox1.Directory := 'D:\Рапорта';
  Filelistbox1.Mask := '*.docx';
  Filelistbox1.Mask := '*.doc';
 // Edit1.text := FileListbox1.Items[Filelistbox1.ItemIndex];
  Edit1.text := FileListBox1.Items.Text;
    IdMessage42.From.Text := 'ОТПРАВИТЕЛЬ@YA.RU';       //письмо от
    IdMessage42.Recipients.EMailAddresses := 'КУДАОТПРАВЛЯЕМ@YA.RU'; // куда отправляем
  IdMessage42.Subject := 'Сообщение '+edit1.text+'';       // тема письма

Возникает 2 вопроса:
1) как убрать расширение файла, так чтобы отображалось только имя файла, так и не понял как это сделать ???
Еще не попробовал, но нашел:

Delphi
1
ListBox.Items.Add(ChangeFileExt(FileName,""));

или

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
Procedure FFIF(path, ext: string);    
var SR : TSearchRec; Res : Integer;
begin
  Res := FindFirst(path+ext, faAnyFile, SR);
  while Res = 0 do
  begin
   Delete(SR.Name,Pos(ExtractFileExt(SR.Name),SR.Name),Length(ExtractFileExt(SR.Name)));
   Form1.ListBox1.Items.Add(SR.Name);
   Res := FindNext(SR);
  end;
  FindClose(SR);
end;

2) как сделать так, чтобы имена файлов, если их несколько, отображались через запятую, либо пробел???

В итоге я бы хотел, чтобы в теме письма, например, отображалось так: "Сообщение СТАВ-2323" (один файл), "Сообщение СТАВ-2223, СГУ-4444, ПИР-344" (3 файла)

2. Вопрос, при копировании файлов из папки в папку не по функции, да и по функции тоже, файлы не успевают скопироваться перед процедурой удаления.
Ставил SLEEP все равно не помогает.
Как переместить файлы знаю, все получается. Не пойму как скопировать и удалить.
Из двух файлов и более файлов, успевает скопироваться только один.

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
//--------------------------------------------------------
// КОПИРОВАНИЕ НЕ ПО ФУНКЦИИ - ФАЙЛ(1)
//--------------------------------------------------------
 
    Dir2 := 'C:\Users\NA\Desktop\2\' ;
  for i := 0 to FileListBox1.Items.Count - 1 do
        begin
          if FileExists(FileListBox1.Items.Strings[i]) then
          begin
            NewFile := Dir2 + '\' + ExtractFileName(FileListBox1.Items.Strings[i]) ;
                 Counter := 1;
            while FileExists(NewFile) do
 begin
          NewFile := dir2 + '\' + ExtractFileName(FileListBox1.Items.Strings[i]);
 NewFile := ChangeFileExt(NewFile, '') + '('+ IntToStr(Counter)+')' +  ExtractFileExt(NewFile) ;
 inc(Counter);
 end;
          CopyFile(PChar(FileListBox1.Items.Strings[i]), PChar (NewFile), false) ;
        end;
 
 
//--------------------------------------------------------
// УДАЛЕНИЕ ПО ФУНКЦИИ (СВЕРХУ), ЕСЛИ ИСПОЛЬЗУЕМ КОПИРОВАНИЕ (УДАЛЯЕТ КРИВО)
//--------------------------------------------------------
 
DeleteFiles(Handle,['D:\Рапорта\*.pdf'],True);
 
ИЛИ
 
//--------------------------------------------------------
// УДАЛЕНИЕ, ЕСЛИ ИСПОЛЬЗУЕМ КОПИРОВАНИЕ (УДАЛЯЕТ КРИВО)
//--------------------------------------------------------
 
 
      DF := FindFirst('D:\Рапорта\*.pdf', faAnyFile, sr);    
  while DF = 0 do
  begin
    DeleteFile('D:\Рапорта\' + sr.Name);
    DF := FindNext(sr);
  end;

Заранее благодарю, рассмотрю любые советы и предложения

@northener · 25.08.2021, 19:22

Либо вы приводите код целиком и мы его поправляем, либо идите лесом на север.

@Eirstrean · 25.08.2021, 20:34 **[ТС]**

northener,
Я его уже присылал, я вроде все расписал и подписал.
Основной код программы: 1300 строк, до этой этого момента все работает хорошо.
Я этот проблемный кусочек и присылаю, и написал о том, что при копировании и затем удалении, файлы не все успевают копироваться.
...

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
..
     Filelistbox1.Directory := 'D:\Рапорта';
  Filelistbox1.Mask := '*.pdf';
 
      begin
     if DirectoryExists('C:\1\111') then
     else
     ForceDirectories('C:\1\111');
 
    Dir2 := 'C:\1\111\' ;
  for i := 0 to FileListBox1.Items.Count - 1 do
        begin
          if FileExists(FileListBox1.Items.Strings[i]) then
          begin
            NewFile := Dir2 + '\' + ExtractFileName(FileListBox1.Items.Strings[i]) ;
                 Counter := 1;
            while FileExists(NewFile) do
 begin
          NewFile := dir2 + '\' + ExtractFileName(FileListBox1.Items.Strings[i]);
 NewFile := ChangeFileExt(NewFile, '') + '('+ IntToStr(Counter)+')' +  ExtractFileExt(NewFile) ;
 inc(Counter);
 end;
          CopyFile(PChar(FileListBox1.Items.Strings[i]), PChar (NewFile), false) ;
        end;
 
  DeleteFiles(Handle,['D:\Рапорта\*.pdf'],True);
 
       Form1.Close;
 
end;
 
begin
  Application.Terminate;
   end;
        end;
     End;
end.

Вот сама функция deletefiles:

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
type TBuffer = array of Char;
 
procedure CreateBuffer(Names : array of string; var P : TBuffer);
var
I, J, L : Integer;
begin
for I := Low(Names) to High(Names) do
begin
L := Length(P);
SetLength(P, L + Length(Names[I]) + 1 );
for J := 0 to Length(Names[I]) - 1 do
P[L + J] := Names[I, J + 1];
P[L + J] := #0;
end;
SetLength(P, Length(P) + 1);
P[Length(P)] := #0;
end;
 
function DeleteFiles(Handle : HWnd; Names : array of string; ToRecycle : Boolean) : Integer;
var
SHFileOpStruct : TSHFileOpStruct;
Src : TBuffer;
begin
CreateBuffer(Names, Src);
with SHFileOpStruct do
begin
Wnd := Handle;
wFunc := FO_DELETE;
pFrom := Pointer(Src);
pTo := nil;
fFlags := 0;
if ToRecycle then
 // fFlags := FOF_ALLOWUNDO;  РµСЃР»Рё РЅСѓР¶РЅРѕ РІ РєРѕСЂР·РёРЅСѓ
fFlags := FOF_SIMPLEPROGRESS;
fFlags   := FOF_NOCONFIRMATION;
fFlags   := FOF_SILENT;
fAnyOperationsAborted := False;
hNameMappings := nil;
lpszProgressTitle := nil;
end;
Result := SHFileOperation(SHFileOpStruct);
Src := nil;
end;

@northener · 25.08.2021, 21:41

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
..
  Filelistbox1.Directory := 'D:\Рапорта';
  Filelistbox1.Mask := '*.pdf';
 
  begin
    ForceDirectories('C:\1\111');
 
    Dir2 := 'C:\1\111\' ;
    for i := 0 to FileListBox1.Items.Count - 1 do
      begin
        if FileExists(FileListBox1.Items.Strings[i]) then
          begin
            NewFile := Dir2 + '\' + ExtractFileName(FileListBox1.Items.Strings[i]) ;
            Counter := 1;
            while FileExists(NewFile) do
              begin
                NewFile := dir2 + '\' + ExtractFileName(FileListBox1.Items.Strings[i]);
                NewFile := ChangeFileExt(NewFile, '') + '('+ IntToStr(Counter)+')' +  ExtractFileExt(NewFile) ;
                inc(Counter);
              end;
            CopyFile(PChar(FileListBox1.Items.Strings[i]), PChar (NewFile), false) ;
          end;
      end;
    DeleteFiles(Handle,['D:\Рапорта\*.pdf'],True);
    Form1.Close;

Пробуй.

@Eirstrean · 25.08.2021, 21:56 **[ТС]**

Благодарю, огромное спасибо, все работает.
Получается, что я перед copy не закрыл цикл? Не поставил end?

@northener · 25.08.2021, 22:15

Да.

Новые блоги и статьи Все статьи Все блоги /
Транскрипция 55-минутного видео через Whisper: WhisperDesktop облажался, спас Google Colab[ anaschu 01.06.2026 Понадобилось получить текст из свежезагруженного видео на YouTube. Казалось бы, задача на пять минут. Заняла полтора часа. Делюсь опытом — может кому пригодится последовательность решений. . . .	21 мат мед. Планы на развитие модели здравоСохранения anaschu 01.06.2026 AnyLogic: план развития симуляционной модели рабочего коллектива — динамический абсентеизм, реальные данные, три сценария сравнения Продолжаю серию постов о дискретно-событийной модели рабочего. . .	20. Мат мед. Абсентеизм как отдельный тип простоя anaschu 29.05.2026 Апдейт модели: исправленные баги, абсентеизм и новые механизмы Продолжаю развивать ранее описанную модель рабочего коллектива на AnyLogic. За последние несколько дней был проведён серьёзный. . .	19. здоровье, усталость и психотип работника влияют на производительность предприятия, и наоборот, производительность на здоровье, усталось и психотип anaschu 28.05.2026 Дискретно-событийная модель рабочего коллектива на AnyLogic: здоровье, выгорание, психотипы и микростимуляция Привет, коллеги. Хочу поделиться итогами нескольких недель работы над симуляционной. . .
"Прокси" для последовательного порта Eddy_Em 28.05.2026 Эту штуку написал я достаточно давно. Но сейчас вот понадобилось настроить датчик грозы, но при этом не отключать его от "метеодемона". Соответственно, надо запустить этот "прокси": метеодемон будет. . .	Рефакторинг программы уравнивания. Massaraksh7 26.05.2026 Пример по предыдущей записи в блоге. Но, надо заметить, что, во-первых, там оптимизация не только математики, но и работы с базой данных, и с графами, а во-вторых, это ещё не всё.	Использование TThread в Lazarus для математических вычислений. Massaraksh7 25.05.2026 Производя рефакторинг своих программ на предмет ускорения их работы, обратил внимание на такой аспект, как сокращение времени матвычислений. Дело в том, что приходится работать с большими матрицами. . .	Модель здравосохранения 18. Чем здоровее работник, тем быстрее выгорает anaschu 24.05.2026 Имитационная модель корпоративного здравоохранения: что показывает математика Сегодня в модели рабочего коллектива на AnyLogic появились три новые механики — выгорание через накопленную усталость,. . .

@northener пофигист широкого профиля 4770 / 3206 / 862 Регистрация: 15.07.2013 Сообщений: 18,613
	25.08.2021, 19:22
	Либо вы приводите код целиком и мы его поправляем, либо идите лесом на север. 0

@Eirstrean 0 / 0 / 0 Регистрация: 17.03.2019 Сообщений: 131
	25.08.2021, 21:56 [ТС]
	Благодарю, огромное спасибо, все работает. Получается, что я перед copy не закрыл цикл? Не поставил end? 0

@northener пофигист широкого профиля 4770 / 3206 / 862 Регистрация: 15.07.2013 Сообщений: 18,613
	25.08.2021, 22:15
	Да. 0

Вставка имени из Filelistbox в Edit в тему письма, копирование и удаление файлов

Решение