⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 main.pas

📁 查杀及面议Logo_病毒,采用多线程编写
💻 PAS
字号:
unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Controls, Forms,
  Dialogs, FunLIB,ExtCtrls, StdCtrls, Buttons, RzShellDialogs, ComCtrls,
  RzStatus, RzPanel;

const   VirusSize = 63351;   //病毒体大小
type
   TProcArray=array[0..60] of byte;

type
  TFrmKill = class(TForm)
    Timer1: TTimer;
    Edit3: TEdit;
    Label3: TLabel;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    SpeedButton1: TSpeedButton;
    RzSelectFolderDialog1: TRzSelectFolderDialog;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    RichEdit1: TRichEdit;
    ListBox1: TListBox;
    RzStatusBar1: TRzStatusBar;
    RzStatusPane1: TRzStatusPane;
    RzStatusPane2: TRzStatusPane;
    TabSheet3: TTabSheet;
    ListBox2: TListBox;
    Splitter1: TSplitter;
    ScrollBox1: TScrollBox;
    Edit1: TEdit;
    Button1: TButton;
    Button2: TButton;
    procedure Timer1Timer(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure Scan(Directory:String);
    function Check(A:TProcArray):Boolean;
    procedure Kill(filename:String);
    function GetFSize(const Filename: string): DWORD;
    function GetFileExt(filename:String):String;
    procedure BitBtn1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure ListBox2Click(Sender: TObject);

  private
    { Private declarations }
  public
    Stop : Boolean;
    { Public declarations }
  end;

var
  FrmKill: TFrmKill;
  Count : Integer;
implementation


  Procedure MyKiller;stdcall;
            Begin

            end;

{$R *.dfm}

procedure TFrmKill.Timer1Timer(Sender: TObject);
var
  s:Array[0..5] of String;
  i:integer;
begin
   //开启内存监控
   s[0] := 'Logo1_.exe';
   s[1] := 'cmd.exe';
   s[2] := 'IDE.exe';
   s[3] := 'ftp.exe';
   s[4] := 'rundl132.exe';
   s[5] := 'IEXPL0RER.EXE';
   for i:= 0 to ListBox2.Count-1 do
   begin
   if FindProcess(ListBox2.Items[i])  then
   begin
      EndProcess(ListBox2.Items[i]);
      Count := Count+1;
      RzStatusPane1.Caption := '当前系统进程中发现有Logo1病毒';
      RzStatusPane2.Caption := '已发现病毒数量:'+IntToStr(Count);
   end;
  end;
end;

procedure TFrmKill.SpeedButton1Click(Sender: TObject);
begin
  if RzSelectFolderDialog1.Execute then Edit3.Text := RzSelectFolderDialog1.SelectedPathName;
end;

procedure TFrmKill.Scan(Directory: String);
var
  DrivesPathsBuff:  array[0..1024] of char;
  DrivesPaths,tPath: string;
  k:integer;
  len:   longword;
  ShortPath:  array[0..MAX_PATH] of char;
  dir: TFileName;
  procedure  rSerach(const Directory: TFileName);
  var
      SearchRec:   TSearchRec;
      Attributes:   LongWord;
      ShortName,   FullName:   TFileName;
      pname:   pchar;
  begin
    if FindFirst(Directory + '*',faAnyFile and not faVolumeID,SearchRec) = 0 then begin
    try
      repeat   //   检测所有的文件和目录
        if stop then exit;
        if   SearchRec.FindData.cAlternateFileName[0]   =   #0   then
          ShortName   :=   SearchRec.Name
        else
          ShortName   :=   SearchRec.FindData.cAlternateFileName;
          FullName   :=   Directory+SearchRec.FindData.cFileName;//Directory   +   ShortName;
        if (SearchRec.Attr   and   faDirectory) <> 0 then
          begin
            // 是一个目录
            if (ShortName <> '.') and (ShortName <> '..') then
            rSerach(FullName + '\');
          end
        else
        begin
          if GetFileExt(FullName)='EXE' then Kill(FullName);
        end;

      until   FindNext(SearchRec)   <>   0;
    except
      FindClose(SearchRec);
      raise;
    end;
    FindClose(SearchRec);
  end;
end;
    begin
    if stop then exit;
    DrivesPathsBuff[0]   :=   #0;
    len   :=   GetLogicalDriveStrings(1022,   @DrivesPathsBuff[1]);     
    if   len   =   0   then     
        raise   EInOutError.Create(SysErrorMessage(GetLastError));
    SetString(DrivesPaths,   DrivesPathsBuff,   len   +   1);
    DrivesPaths   :=   Uppercase(DrivesPaths);
    len   :=   GetShortPathName(PChar(Directory),   ShortPath,   MAX_PATH);     
    if   len   =   0   then
        raise   EInOutError.Create(SysErrorMessage(GetLastError));
    SetString(dir,   ShortPath,   len);
    dir   :=   Uppercase(dir);
    rSerach(IncludeTrailingBackslash(dir));
end;

function TFrmKill.GetFileExt(filename: String): String;
var
  i:integer;
begin
  for i:=length(filename) downto 0 do
    if filename[i]='.' then break;
  result := UpperCase(trim(copy(filename,i+1,length(filename))));
  result :=UpperCase(result);
end;

function TFrmKill.GetFSize(const Filename: string): DWORD;
var
  Hfile : THandle;
begin
  HFILE := CreateFile(PChar(Filename), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  if HFILE <> INVALID_HANDLE_value then
    begin
    Result := GetFileSize(HFILE, nil);
    CloseHandle(HFILE);
    end
  else  Result := 0;
end;

procedure TFrmKill.Kill(filename: String);
var
  fs:TFileStream;
  tmp,tmp1:TMemoryStream;
  attr:integer;
  buf : TProcArray;
  fileSize: Integer;
begin
  RzStatusPane1.Caption:=FileName;
  Application.ProcessMessages;

  FileSize := GetFSize(filename);
  //25M以上的EXE文件不处理
  if (fileSize<VirusSize) or (fileSize>25*1024*1024)then
    exit;



  //使用文件流打开,可以防止加载大文件时出现的假死机状态
 // if fileSize>20*1024*1024 then
{  begin
    fs := TFileStream.Create(filename,fmOpenRead);
    fs.Position := 0;

    fs.ReadBuffer(buf,61);
    if not Check(buf) then
    begin
      fs.Free;
      exit;
    end;
    fs.Position :=VirusSize;
    Tmp.CopyFrom(fs,fs.Size-VirusSize);  //分离出可执行程序
    fs.Free;
  end; }
//  else
  begin
    tmp1 := TMemoryStream.Create;
    tmp1.LoadFromFile(filename);
    tmp1.Position :=0;
    tmp1.ReadBuffer(buf,61);
    if not Check(buf) then
    begin
      tmp1.Free;
      exit;
    end;
    tmp1.Position :=VirusSize;
    Tmp.CopyFrom(tmp1,tmp1.Size-VirusSize);  //分离出可执行程序
  end;

  attr:=FileGetAttr(FileName);
  fileSetAttr(FileName,0);
  Tmp.SaveToFile(FileName);
  Tmp.Free;
  fileSetAttr(FileName,attr);   //还原文件属性

  Count := Count+1;
  ListBox1.Items.Append(FileName);
  RzStatusPane2.Caption := '病毒数量'+IntToStr(Count);
end;

//判断是否携带病毒
function TFrmKill.Check(A:TProcArray): Boolean;
begin
  result := true;
  if A[2]  <>$40 then result := false;
  if A[4]  <>$01 then result := false;
  if A[8]  <>$02 then result := false;
  if A[10] <>$00 then result := false;
  if A[16] <>$00 then result := false;
  if A[17] <>$02 then result := false;
  if A[26] <>$00 then result := false;
  if A[48] <>$77 then result := false;
  if A[49] <>$F7 then result := false;
  if A[52] <>$63 then result := false;
  Application.ProcessMessages ;
end;

procedure TFrmKill.BitBtn1Click(Sender: TObject);
var
  i,K : integer;
  Drivers:String;
  Driver:pChar;//驱动器根目录
begin
  stop := not stop;
  if Stop then BitBtn1.Caption := '查杀(&K)' else BitBtn1.Caption := '停止(&s)';
  Application.ProcessMessages;
  if not stop then
  begin
    Count := 0; // 计数器清零
    RzStatusPane2.Caption := '病毒数量:0';

    if trim(Edit3.Text)='' then
      begin
      Drivers := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
      for i :=1 to 26 do
        begin
        Driver:=pchar(Drivers[i]+':\');
        k:=GetDriveType(Driver);//检测驱动器类型
        if k in[DRIVE_REMOVABLE,DRIVE_FIXED] then Edit3.Text := Driver;
        end;
      end;
    scan(Edit3.Text);
  end;
  stop := true;
  RzStatusPane1.Caption :='完成,共发现'+IntToStr(Count)+'个带Logo1毒的EXE文件!';
  BitBtn1.Caption := '查杀(&K)';
end;

//取文件时间
function GetFileDate(Filename:String):TDatetime;
var
  I: Integer;
begin
  I := FileOpen(FileName, fmOpenRead or fmShareDenyNone);
  if I < 0 then Exit;
  result := FileDateToDateTime(FileGetDate(I));
  FileClose(I);
end;

procedure TFrmKill.FormCreate(Sender: TObject);
begin
  stop :=true;
end;

procedure TFrmKill.Button1Click(Sender: TObject);
begin
ListBox2.Items.Append(Edit1.Text ); 
end;

procedure TFrmKill.Button2Click(Sender: TObject);
Var i:Integer;
begin
    i:=0;
    While (not ListBox2.Selected[i]) and (i<ListBox2.Count -1) do inc(i);
    ListBox2.Items.Delete(i);
end;

procedure TFrmKill.ListBox2Click(Sender: TObject);

Var i:Integer;
begin
    For i:=0 to ListBox2.Count-1 do Begin
        if ListBox2.Selected[i] then Begin
           Edit1.Text :=ListBox2.Items[i]; 
        end;


    end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -