Программа распознается как рекламная.

[MotoArhangel]

Добрый день. Почему срабатывает антивирус?  В добавок, добавление директории в исключения результата не дает.

Реакция:

Событие: Объект удален
Пользователь: MotoArhangel-NB\MotoArhangel
Тип пользователя: Активный пользователь
Имя программы: taskmgr.exe
Путь к программе: C:\Windows\System32
Компонент: Файловый Антивирус
Описание результата: Удалено
Тип: Рекламная программа
Название: not-a-virus:HEUR:AdWare.Win32.Generic
Точность: Эвристический анализ
Степень угрозы: Средняя
Тип объекта: Файл
Имя объекта: Диагностика.exe
Путь к объекту: C:\Users\MotoArhangel\Desktop\Диагностика\Win32\Release
MD5: 9CDC25E04A1579857C62F32A4A077565

Код:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, DateUtils,
  System.IniFiles, Vcl.ComCtrls;

type
  TMForm = class(TForm)
    BClose: TButton;
    MLog: TMemo;
    RtfText: TRichEdit;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormActivate(Sender: TObject);
    procedure BCloseClick(Sender: TObject);
  private
    { Private declarations }
    Procedure Log(str: string);
    Function FindTextRTF(FilePath, aSearchText: string;
      aSearchDate: string = 'за '): string;
  public
    { Public declarations }
  end;

var
  MForm: TMForm;

implementation

{$R *.dfm}

Procedure TMForm.Log(str: string);
begin
  MLog.Lines.Add('[' + DateTimeToStr(now) + ']' + str);
end;

procedure TMForm.BCloseClick(Sender: TObject);
begin
  MForm.Close;
end;

Function TMForm.FindTextRTF(FilePath, aSearchText: string;
  aSearchDate: string = 'за '): string;
Var
  SPos, DPos, EPos: Integer;
begin
  result := '';
  Log('Обработка: ' + ExtractFileName(FilePath));
  with RtfText do
  begin
    Lines.LoadFromFile(FilePath);
    Log('Поиск параметров');
    if pos(aSearchText, RtfText.Text) <> 0 then
    begin
      SPos := 0;
      EPos := Length(Text);
      Lines.BeginUpdate;
      while FindText(aSearchDate, SPos, EPos, [stMatchCase]) <> -1 do
      begin
        HideSelection := False;
        EPos := Length(Text) - SPos;
        DPos := FindText(aSearchDate, SPos, EPos, [stMatchCase]);
        Inc(SPos, Length(aSearchDate));
        SelStart := DPos;
        SelLength := Length(aSearchDate) + 20;
        result := Trim(SelText);
      end;
      Lines.EndUpdate;
    end;
    Clear;
  end;
end;

procedure TMForm.FormClose(Sender: TObject; var Action: TCloseAction);
var
  StrList: TStringList;
begin
  StrList := TStringList.Create;
  try
    if FileExists(extractfilepath(paramstr(0)) + 'log.txt') then
      StrList.LoadFromFile(extractfilepath(paramstr(0)) + 'log.txt');
    StrList.Add(MLog.Lines.Text);
    StrList.SaveToFile(extractfilepath(paramstr(0)) + 'log.txt');
  finally
    StrList.Free;
  end;
end;

procedure TMForm.FormActivate(Sender: TObject);
var
  StrList: TStringList;
  Dir, DirCopyFB, DirCopyKB, FindName, FBName, KBName: string;
  procedure FindFile;
  var
    Search: TSearchRec;
  begin
    if FindFirst(Dir + FindName, faAnyFile, Search) = 0 then
      repeat
      begin
        StrList.Add(Search.Name);
        Log('Найден файл: ' + Search.Name);
      end;
      until findNext(Search) <> 0;
    FindClose(Search);
    if StrList.Count = 0 then
      Application.Terminate;
  end;

  procedure CopyFindFile;
  var
    i: Integer;
    str: string;
    procedure aCopyFiles(aDirCopy, bText: string);
    var
      FDate: TFormatSettings;
    begin
      FDate.DateSeparator := '_';
      FDate.ShortDateFormat := 'YYYY/DD/mm';
      Log('Копируется: ' + StrList);
      if not CopyFile(Pchar(Dir + StrList),
        Pchar(aDirCopy + str + ' от ' + DateToStr(StrToDate(copy(StrList,
        pos(YearOf(now).ToString, StrList), 10), FDate)) + bText +
        ExtractFileExt(Dir + StrList)), False) then
        Log('Файл ' + StrList + ' не скопирован')
      else
        Log('Копия завершена: ' + StrList);
    end;

  begin
    for i := 0 to StrList.Count - 1 do
    begin
      str := FindTextRTF(Dir + StrList, FBName);
      if Length(str) > 0 then
        aCopyFiles(DirCopyFB, ' ФБ')
      else
      begin
        str := FindTextRTF(Dir + StrList, KBName);
        if Length(str) > 0 then
          aCopyFiles(DirCopyKB, ' КБ')
      end;
    end;
  end;

  procedure ReadSetting;
  var
    Ini: Tinifile;
    procedure SaveSetting;
    begin
      Ini := Tinifile.Create(extractfilepath(paramstr(0)) + 'Setting.ini');
      Ini.WriteString('Путь', 'Путь к файлу', Dir);
      Ini.WriteString('Поиск', 'Фильтр файлов', FindName);
      Ini.WriteString('Путь', 'Путь копии ФБ', DirCopyFB);
      Ini.WriteString('Путь', 'Путь копии КБ', DirCopyKB);
      Ini.WriteString('Поиск', 'Поиск по фразе ФБ', FBName);
      Ini.WriteString('Поиск', 'Поиск по фразе КБ', KBName);
      Ini.Free;
    end;

  begin
    Ini := Tinifile.Create(extractfilepath(paramstr(0)) + 'Setting.ini');
    Dir := Ini.ReadString('Путь', 'Путь к файлу','c:\');
    FindName := Ini.ReadString('Поиск', 'Фильтр файлов', '*1700*.RTF');
    DirCopyFB := Ini.ReadString('Путь', 'Путь копии ФБ','c:\');
    DirCopyKB := Ini.ReadString('Путь', 'Путь копии КБ','c:\');
    FBName := Ini.ReadString('Поиск', 'Поиск по фразе ФБ',
      'федерального бюджета');
    KBName := Ini.ReadString('Поиск', 'Поиск по фразе КБ',
      'региональных бюджетов');
    Ini.Free;
    Log('Чтение параметров закончено');
    SaveSetting;
  end;

begin
  ReadSetting;
  StrList := TStringList.Create;
  try
    FindFile;
    CopyFindFile;
  finally
    StrList.Free;
  end;
end;

end.

 

 

[Danila T.]

Добрый день,

Воспользуйтесь этой инструкцией: https://support.kaspersky.ru/viruses/answers/1870

Спасибо.

[MotoArhangel]

Добрый день,

Воспользуйтесь этой инструкцией: https://support.kaspersky.ru/viruses/answers/1870

Спасибо.

Отправил.