Link to home
Start Free TrialLog in
Avatar of letchev
letchev

asked on

Creating an Anti Happy Time

Dear friends,

By the first time in my 15 years as user/programmer of computer I found a virus in my computer! The Happy Time.

Good programmer the author of Happy Time!

I have 25000 files infested in my computer, certainly thre is a way to ´delete´ the script from each file, BUT I unknow that
´script´ Them begin where the html file ends ´</html>´

Could you please help me to solve this hard problem? and
save hours of work?

Best regards



Yours

LeTchev
Avatar of mokule
mokule
Flag of Poland image

may be this helps u
with these two procedures u can search all desired file in a drive


//-------------------------------------------------------------
// recursively searching all subfolders starting from Path
//-------------------------------------------------------------
procedure TFSzperacz.LookInDir(Path: string);
var
  NewPath: string;
  srd: TSearchRec;
  idir: integer;
begin
  idir := FindFirst(Path + '*.*', faDirectory, srd);
  while ((idir = 0) and (not ST.Terminated)) do
    begin
    if (((srd.Attr and faDirectory) > 0)
                   and (srd.Name[1] <> '.')) then
      begin
      NewPath := Path + srd.Name + '\';
      SearchFile(NewPath);
      LookInDir( NewPath);
    end;
    idir := FindNext(srd);
  end;
  FindClose(srd);
end;

//-------------------------------------------------------------
// finding files in a folder
//-------------------------------------------------------------
procedure TFSzperacz.SearchFile(Path: string);
var
  sr: TSearchRec;
  i: integer;
  j: integer;
begin
  StatusBar1.Panels[1].Text := Path;
  for j := 0 to ListBox1.Items.Count - 1 do
    begin
    i := FindFirst(Path + ListBox1.Items[j], faAnyFile, sr);
    while ((i = 0) and (not ST.Terminated)) do
      begin
//
// do cutting here
//
      i := FindNext(sr);
      end;
    FindClose(sr);
    end;
end;


in ListBox1 You should have desired masks for searched files
Avatar of geobul
geobul

Hi,

First I have to say that I'm not familiar with that virus. If I understand you right it places something in your html files after their end. Let's presume you already created a list of these files in slFiles (if need help there let me know).

var
  slFiles, slText: TStringList;
  i,k: integer;
begin
  slFiles := TStringList.Create;
  slText := TStringList.Create;
  try
    // fill the list here
    ...
    // now remove everything after the html end
    for i := 0 to slFiles.Count - 1 do begin
       slText.LoadFromFile(slFiles[i]);
       k := Pos('</html>', slText.Text); // or  
       // k := Pos('</html>', LowerCase(slText.Text)); // if you may have </HTML> somewhere
       if k > 0 then begin
         slText.Text := Copy(slText.Text, 1, k+6);
         slText.SaveToFile(slFiles[i]);
       end;
    end;
  finally
    slFiles.Free;
    slText.Free;
  end;
end;

Regards, Geo
Try the code above on one or two files you know replacing the '...' with:

  slFiles.Add('c:\folder\file1.html');
  slFiles.Add('c:\folder\file2.html');

and see if this is what you want. Make copies of these files beforehand for safety.
Avatar of letchev

ASKER

Geobul,

I want a script such as Happy Time which scan all files from all drives and cut out the text after the end of an html page:
</html>. It is all I need.

Thank you again.

LeTchev
//This program searches all drive and can remove Your script from files
// You should uncomment this * for full functionality
// Mind that you can't stop it
// It is not written on threads
// Main.pas

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    Edit2: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Edit3: TEdit;
    Edit4: TEdit;
    Label4: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    function  LookInDir(Path: string):boolean;
    function SearchFile(Path: string):boolean;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  LookInDir(Edit4.Text);
end;

//-------------------------------------------------------------
// recursively searching all subfolders starting from Path
//-------------------------------------------------------------
function TForm1.LookInDir(Path: string): boolean;
var
  NewPath: string;
  srd: TSearchRec;
  idir: integer;
begin
  result := True;
  idir := FindFirst(Path + '*.*', faDirectory, srd);
// it'll be better to use threads
//  while ((idir = 0) and (not ST.Terminated)) do
  while (idir = 0) do
    begin
    if (((srd.Attr and faDirectory) > 0)
                   and (srd.Name[1] <> '.')) then
      begin
      NewPath := Path + srd.Name + '\';
      if not SearchFile(NewPath) then
        begin
        result := False;
        break;
        end;
//----- uncoment below to look in directories
//*    if not LookInDir( NewPath) then
//*       begin
//*        result := False;
//*        break;
//*        end;

    end;
    idir := FindNext(srd);
  end;
  FindClose(srd);
end;

//-------------------------------------------------------------
// finding files in a folder
//-------------------------------------------------------------
function TForm1.SearchFile(Path: string):boolean;
var
  sr: TSearchRec;
  i: integer;
  j: integer;

  slText: TStringList;
  k: integer;
begin
  result := True;
  slText := TStringList.Create;
  Edit1.Text := Path;
  i := FindFirst(Path + Edit3.Text, faArchive, sr);
  try
// it'll be better to use threads
//    while ((i = 0) and (not ST.Terminated)) do
    while (i = 0) do
      begin
      Edit2.Text := Path + sr.Name;
//----------------------------------
//----------------------------------
// like geobul
// I don't test this
// it won't find '< / html>' and so on
       slText.LoadFromFile(Edit2.Text);
//       k := Pos('</html>', slText.Text); // or
       k := Pos('</html>', LowerCase(slText.Text)); // if you may have </HTML> somewhere
       if k > 0 then begin
         slText.Text := Copy(slText.Text, 1, k+6);

//!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
//it can do a lot of harm. Be carefull
// uncomment the line below on your own resposibilty
//*         slText.SaveToFile(slFiles[i]);
//!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
         end;
//----------------------------------
//----------------------------------

//---- comment below but you can't stop then
    if Application.MessageBox(PChar('Continue?'),PChar('Find file'),MB_YESNO) <> IDYES then
      begin
      result := False;
      exit;
      end;
//----------------------------------


      i := FindNext(sr);
      end;
  except
  end;
    FindClose(sr);
    slText.Free;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
  Edit4.Text := 'C:\';
  Edit3.Text := '*.*';
end;

end.

/////////////////////////////////////////////////////////
Main.dfm
/////////////////////////////////////////////////////////
object Form1: TForm1
  Left = 35
  Top = 2
  Width = 558
  Height = 264
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 16
    Top = 72
    Width = 42
    Height = 13
    Caption = 'Directory'
  end
  object Label2: TLabel
    Left = 16
    Top = 128
    Width = 16
    Height = 13
    Caption = 'File'
  end
  object Label3: TLabel
    Left = 416
    Top = 24
    Width = 44
    Height = 13
    Caption = 'File mask'
  end
  object Label4: TLabel
    Left = 16
    Top = 24
    Width = 79
    Height = 13
    Caption = 'Starting directory'
  end
  object Edit1: TEdit
    Left = 16
    Top = 88
    Width = 521
    Height = 21
    TabOrder = 0
  end
  object Button1: TButton
    Left = 240
    Top = 184
    Width = 75
    Height = 25
    Caption = 'Start'
    TabOrder = 1
    OnClick = Button1Click
  end
  object Edit2: TEdit
    Left = 16
    Top = 144
    Width = 521
    Height = 21
    TabOrder = 2
  end
  object Edit3: TEdit
    Left = 416
    Top = 40
    Width = 121
    Height = 21
    TabOrder = 3
    Text = '*.*'
  end
  object Edit4: TEdit
    Left = 16
    Top = 40
    Width = 345
    Height = 21
    TabOrder = 4
    Text = 'C:\'
  end
end
Avatar of letchev

ASKER

Dear Mokule,

I run your script, however it does not you promisses.

Thank you for your interest and patience.

Regards,

if you know the text saved from the virus, it could be replaced with the empty string (or one space) using my solution for the question:
https://www.experts-exchange.com/questions/20932619/Search-Replace.html

emil
Sorry for not answering so long. I've somehow missed Your post
Could You say a word what was wrong.
I cut it from working application.
Do You make necessary changes as in comment?
ASKER CERTIFIED SOLUTION
Avatar of esoftbg
esoftbg
Flag of Bulgaria image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial