服务器的文件不能修改器,荒野行动gg修改器脚本安装文件运行出错

PrivateDeclareFunctionCreateDirectoryLib"kernel32"Alias"CreateDirectoryA"(ByVallpPathNameAsString,lpSecurityAttributesAsSECURITY_ATTRIBUTES)AsLong

PrivateTypeSECURITY_ATTRIBUTES

nLengthAsLong

lpSecurityDescriptorAsLong

bInheritHandleAsLong

EndType

SubMain()

'在C盘创建了"VB编程乐园"目录

CallCreateNewDirectory("C:\VB编程乐园")

MsgBox"在C盘创建了VB编程乐园目录"

EndSub

PublicSubCreateNewDirectory(NewDirectoryAsString)

DimsDirTestAsString

DimSecAttribAsSECURITY_ATTRIBUTES

DimbSuccessAsBoolean

DimsPathAsString

DimiCounterAsInteger

DimsTempDirAsString

DimiFlagAsInteger

iFlag=0

sPath=NewDirectory

IfRight(sPath,Len(sPath))<>""Then

sPath=sPath&""

EndIf

iCounter=1

DoUntilInStr(iCounter,sPath,"")=0

iCounter=InStr(iCounter,sPath,"")

sTempDir=Left(sPath,iCounter)

sDirTest=Dir(sTempDir)

iCounter=iCounter 1

'创建目录

SecAttrib.lpSecurityDescriptor=&O0

SecAttrib.bInheritHandle=False

SecAttrib.nLength=Len(SecAttrib)

bSuccess=CreateDirectory(sTempDir,SecAttrib)

Loop

EndSub->虽然采取了防范措施，来保证代码

'在普通情况下没有错误，但文件系统是不可预知的简单的服务器文件备份办法压缩文件名自动按日期命名

dimFileName,WshShell,fs,MyCommandFileName=cstr(now)+".RAR"

MyCommand="rara"+FileName+"要压缩的文件名或目录名"

SetWshShell=WScript.CreateObject("WScript.Shell")

Setfs=CreateObject("Scripting.FileSystemObject")

iffs.fileExists(FileName)then

fs.DeleteFileFileName,true

end

ifWshShell.runMyCommand

将以上文件另存为一个.VBS添加计划任务按你说需要的时间运行.vbs如每个礼拜一次

或每个月一次等计划任务会自动压缩你指定的目录.生成一个日期文件名.rar

以下是实现的代码：

PrivateSubForm_Load()

DimabcasInteger

fora=0toLabel1.Count-1

Labe11(a).BackStyle=0

next

EndSub

PrivateSubLabel1_MouseMove(IndexAsInteger,ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle)

StaticaAsInteger

'实现蓝底的背景

Label1(Index).BackStyle=1

Label1(index).BackColor=rgb(0,0,255)

'用于实现上一项背景透明

Ifa>=0Anda<>IndexThen

Label1(a).BackStyle=0

EndIf

a=Index

EndSub

注：以上是以LabeblBox控件为菜单项，菜单项多少不限

接下来我们将调用CreateKey方法这可以通过创建一个带有Private类和Public类(设定Instancing=MultiUse)的ActiveXEXE工程看到，在2个类模块中添加下面的代码：

PublicSubPublicSub(ByValvalueAsLong)

'

EndSub

PublicFunctionPublicFunction(ByValvalueAsLong)AsLong

'

EndFunction

FriendSubFriendSub(ByValvalueAsLong)

'

EndSub

FriendFunctionFriendFunction(ByValvalueAsLong)AsLong

'

EndFunction

然后，在表单模块中创建一个循环，执行每个例程许多次

'Date: 2010/6/18

'Author: Demon

'QQ: 380401911

'E-mail: still.demon@gmail.com

'Website:

Const Email_From="ddd@163.com" '发件人邮箱

Const Password="password" '发件人邮箱密码

Const Email_To="380401911@qq.com" '收件人邮箱

Set CDO=CreateObject("CDO.Message") '创建CDO.Message对象

CDO.Subject="From Demon" '邮件主题

CDO.From=Email_From '发件人地址

CDO.To=Email_To '收件人地址

CDO.TextBody="Hello world!" '邮件正文

cdo.AddAttachment="C:\hello.txt" '邮件附件文件路径

Const schema="" '规定必须是这个，我也不知道为什么

With CDO.Configuration.Fields '用with关键字减少代码输入

.Item(schema & "sendusing")=2 '使用网络上的SMTP服务器而不是本地的SMTP服务器

.Item(schema & "smtpserver")="smtp.gmail.com" 'SMTP服务器地址

.Item(schema & "smtpauthenticate")=1 '服务器认证方式

.Item(schema & "sendusername")=Email_From '发件人邮箱

.Item(schema & "sendpassword")=Password '发件人邮箱密码

.Item(schema & "smtpserverport")=465 'SMTP服务器端口

.Item(schema & "smtpusessl")=True '是否使用SSL

.Item(schema & "smtpconnectiontimeout")=60 '连接服务器的超时时间

.Update '更新设置

End With

CDO.Send '发送邮件

虽然对象能自动注销，但是数据连接不会马上断开，可能会导致一些内存不能被系统重新分配

"

Else

objFSO.CreateFolder targetpath & Right(path,Len(path)-Len(sourcepath))

Set folder=objFSO.GetFolder(path)

Set files=folder.files

For Each file in files

If StrComp(objFSO.GetExtensionName(file.name),"zip",vbTextCompare)=0 Then

objShell.NameSpace(targetpath & Right(path,Len(path)-Len(sourcepath))).CopyHere objShell.NameSpace(path & "" & file.name).Items(),256

End If

Next

Set subfolder=folder.subfolders

For Each sfolder in subfolder

GetZipFile path & "" & sfolder.name

Next

End If

End Function

Set objFSO=Server.CreateObject("Scripting.FileSystemObject")

Set oApp=CreateObject("Shell.Application")

sourcepath="C:\zipfiles"

targetpath="D:\tmp" & objFSO.GetFileName(sourcepath)

GetZipFile sourcepath

Set objFSO=Nothing

Set oApp=Nothing

接悬赏

1)绝对路径方法

比如你的DLL文件位于c:\testDLL\debug\testDLL.dll

一般来说，你需要在VB中作如下声明

DeclareSubmytestLib"c:\testDLL\dubug\testDLL.dll"(ByValxAsLong)

另外的一个变通方法是把testDLL.dll放在windows的系统目录下，这样，你就可以直接引用文件名了

二、关闭WinNT/2000的默认共享

用记事本编辑如下内容：

DimWSHShell'定义变量

setWSHShell=CreateObject("WScript.shell")'创建一个能与操作系统沟通的对象WSHShell

Dimfso,dc

Setfso=CreateObject("Scripting.FileSystemObject")'创建文件系统对象

setdc=fso.Drives'获取所有驱动器盘符

ForEachdindc

Dimstr

WSHShell.run("netshare"&d.driveletter&"$/delete")'关闭所有驱动器的隐藏共享

next

WSHShell.run("netshareadmin$/delete")

WSHShell.run("netshareipc$/delete")'关闭admin$和ipc$管道共享

现在来测试一下，先打开cmd.exe，输入netshare命令就可以看到自己机子上的共享。