天马行空工作室

 找回密码
 加入天马
搜索
查看: 8734|回复: 19

【VB】--【黑客个人记事本】

[复制链接]
发表于 2012-4-18 23:07:05 | 显示全部楼层 |阅读模式


已经不学vb了,将之前写的一个程序发一下,文件下载在最后,12点断网,如果今天没办法将帖子发完,那么明天再继续……%>_<%

因为是以前写的,代码有些幼稚……


【黑客个人记事本】


黑客个人记事本的主界面:
001.记事本的一般功能
002.支持自定义链接,打开其它程序更方便
003.临时区,为文档制作提供复制粘贴方便
004.可以在NEW中调用多个本程序,方便多文 档操作
005.方便调用本程序自带的工具集 黑客个人记事本的工具集:
001:自动查找显示主机名和IP地址
002:轻松调用系统程序
003:黑客常用网站快捷进入
004:附带本地时间显示
005:一键查询显示本机的系统配置
006:各种常用命令显示
007:一键显示当前电脑运行日志
008:附带端口资料查询器
009:附带网页代码查询器
010:可简化界面操作


黑客个人记事本的网页代码查询:
001:具有浏览器的一般功能,可用于;浏览网页。
002:一键显示网页源代码
003:可将网站域名解析为主机IP地址

黑客个人记事本的端口资料查询器
001:查询端口的用途
002:显示端口的危险性,趁早发现可疑端口清杀木马
003:端口基本知识介绍与查询方式


















































评分

参与人数 2自由 +2 给力 +8 酱油 +10 收起 理由
小路 + 3 很给力!
random_ + 2 + 5 + 10 此乃神帖

查看全部评分

 楼主| 发表于 2012-4-18 23:10:02 | 显示全部楼层

继续界面。





































 楼主| 发表于 2012-4-18 23:11:17 | 显示全部楼层



程序共6个窗体和2个模块










话说vb很久没接触快忘光了……



 楼主| 发表于 2012-4-18 23:13:25 | 显示全部楼层




/******************************************************************************************



窗体一:记事本界面。







/******************************************************************************************



000.声明和全局变量


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
'打开文件或程序的api
Dim HH
Private ss As String '打开文件
Dim x1 As Double
Dim y1 As Double
Dim dd As String Dim r As Long
Dim cx As Integer
Public zifuchuansong As Integer
Dim dkbc As Boolean '保存
Dim bcun As Boolean
Dim ljj As String '保存用的路径
Dim dat As String
Dim cl As Integer


001.对于窗体一在加载窗体的时候就做了一件事,就是读取文件。包括心情和程序左边的快捷方式栏。这些文件全部都只是储存一点数据而已。由于是很久前写的程序,代码都有些幼稚……



Private Sub Form_Load()
On Error Resume Next
dkbc = False
cl = 1
Dim nextline As String
Dim linefromfile As String cSysTray1.InTray = True '图标
Randomize
datname = App.Path & "\erbi.lucifer" '加载心情
If Dir(datname) = "" Then
MsgBox "未找到数据文件", , "提示"

Exit Sub
Else
Dim TempFile As Long
Dim LoadBytes() As Byte TempFile = FreeFile
Open datname For Binary As #TempFile
ReDim LoadBytes(1 To LOF(TempFile)) As Byte
Get #TempFile, , LoadBytes
Close TempFile Text3.Text = StrConv(LoadBytes, vbUnicode)
End If


'以下是加载各个文件的内容,用于记事本左边打开程序所用
Dim a() As String
Dim flilenum1 As String
flilenum1 = App.Path & "\erbi\erbi1.dll"
ReDim Preserve a(0 To 0) As String
Open flilenum1 For Input As #1
While Not EOF(1)
Line Input #1, a(i)
i = i + 1
ReDim Preserve a(0 To i) As String
Wend
Close #1
Text4.Text = a(0)
Label9.ToolTipText = a(1)

Dim b() As String
Dim flilenum2 As String
flilenum2 = App.Path & "\erbi\erbi2.dll"
ReDim Preserve b(0 To 0) As String
Open flilenum2 For Input As #1
While Not EOF(1)
Line Input #1, b(i)
i = i + 1
ReDim Preserve b(0 To i) As String
Wend
Close #1
Text5.Text = b(0)
Label10.ToolTipText = b(1)

Dim c() As String
Dim flilenum3 As String
flilenum3 = App.Path & "\erbi\erbi3.dll"
ReDim Preserve c(0 To 0) As String
Open flilenum3 For Input As #1
While Not EOF(1)
Line Input #1, c(i)
i = i + 1
ReDim Preserve c(0 To i) As String
Wend
Close #1
Text6.Text = c(0)
Label11.ToolTipText = c(1) Dim d() As String

Dim flilenum4 As String
flilenum4 = App.Path & "\erbi\erbi4.dll"
ReDim Preserve d(0 To 0) As String
Open flilenum4 For Input As #1
While Not EOF(1)
Line Input #1, d(i)
i = i + 1
ReDim Preserve d(0 To i) As String
Wend
Close #1
Text7.Text = d(0)
Label12.ToolTipText = d(1)

Dim e() As String
Dim flilenum5 As String
flilenum5 = App.Path & "\erbi\erbi5.dll"
ReDim Preserve e(0 To 0) As String
Open flilenum5 For Input As #1
While Not EOF(1)
Line Input #1, e(i)
i = i + 1
ReDim Preserve e(0 To i) As String
Wend
Close #1
Text8.Text = e(0)
Label13.ToolTipText = e(1)

End Sub



002.【NEW】按钮


Private Sub Label14_Click()
'Dim a As New Form1
'a.Show
'a.Text1.Text = ""
Dim new1 As String
new1 = App.Path & "\erbi-lucifer.exe" 'FileName
Shell new1, vbNormalFocus
End Sub

'原先是打算直接清空文本框的,后来又改成新开一个窗体,到最后又改成新开一个程序……



003.【OPEN】按钮,打开文件并文本框内显示……


Private Sub Label15_Click()
On Error Resume Next
dkbc = True
Dim lFileLong As Double
Dim lReadL As Double
Dim lReadLs As Double
Dim iSpeed As Integer
iSpeed = 50
lReadL = 1024
lReadL = lReadL * iSpeed
lReadLs = 0
Text1.Text = ""
fn = FreeFile
With CommonDialog1
.DialogTitle = "打开"
.CancelError = False
'ToDo: 设置 common dialog 控件的标志和属性
.Filter = "所有文件 (*.*)|*.*"
.ShowOpen
If Len(.FileName) = 0 Then
Exit Sub
End If

End With
ljj = CommonDialog1.FileName
Open CommonDialog1.FileName For Binary As #fn
lFileLong = LOF(fn)
Do While lReadLs < lFileLong And iStop = 0
If lFileLong - lReadLs <= lReadL Then lReadL = lFileLong - lReadLs
Seek #fn, lReadLs + 1
DoEvents
Data1 = Input$(lReadL, #fn)
lReadLs = lReadLs + lReadL
Text1.Text = Text1.Text & Data1
DoEvents
Loop
Close #fn

End Sub







004.【SAVE】按钮,打开文件后可以直接保存,但是没有打开文件就会弹出对话框进行保存&



Private Sub Label16_Click()
On Error Resume Next If Text1.Text = "" Then bcun = False If dkbc = True And bcun = True Then
Open ljj For Output As #1 Print #1, Text1.Text
Close #1
End If If dkbc = False And bcun = True Then
With CommonDialog1
.Flags = cdlOFNHideReadOnly & cdlOFNOverwritePrompt
.DialogTitle = "保存"
.CancelError = False
'ToDo: 设置 common dialog 控件的标志和属性
.Filter = "所有文件 (*.*)|*.*"
.ShowSave


sfile = .FileName
End With
FileName = sfile
Open FileName For Output As #1 Print #1, Text1.Text
Close #1

End If
End Sub




005.【SAVE AS】按钮,直接弹出保存对话框,保存文本框内容。



Private Sub Label17_Click()
On Error Resume Next
With CommonDialog1
.Flags = cdlOFNHideReadOnly & cdlOFNOverwritePrompt
.DialogTitle = "保存"
.CancelError = False
'ToDo: 设置 common dialog 控件的标志和属性
.Filter = "所有文件 (*.*)|*.*"
.ShowSave
If Len(.FileName) = 0 Then
Exit Sub
End If
sfile = .FileName
End With
FileName = sfile
Open FileName For Output As #1 Print #1, Text1.Text
Close #1
End Sub


006.【FONT】按钮。选择并设置字体。


Private Sub Label1_Click()
On Error Resume Next
With CommonDialog1
.Flags = cdlCFBoth + cdlCFPrinterFonts
.DialogTitle = "字体"
.CancelError = False
'ToDo: 设置 common dialog 控件的标志和属性
.Filter = "所有文件 (*.*)|*.*"
.ShowFont

Text1.FontName = CommonDialog1.FontName
Text1.FontSize = CommonDialog1.FontSize
Text1.FontBold = CommonDialog1.FontBold
Text1.FontItalic = CommonDialog1.FontItalic
Text1.FontUnderline = CommonDialog1.FontUnderline
Text1.FontStrikethru = CommonDialog1.FontStrikethru End With
End Sub






 楼主| 发表于 2012-4-18 23:16:08 | 显示全部楼层


007.【HELP】按钮,弹出窗体3.也就是工具窗体……


Private Sub Label32_Click()
Form3.Show
End Sub


008.【SAVE】按钮,在心情栏后面的那个,用于保存心情……



Private Sub Label31_Click()
Dim FileName As String FileName = App.Path & "\erbi.lucifer"
Open FileName For Output As #1 Print #1, Text3.Text
Close #1
End Sub



009.【清空】按钮,用于清空临时区的文本内容。


Private Sub Label24_Click()
Text2.Text = ""
End Sub



010.【隐藏】按钮,隐藏临时区。计算并设置坐标与长宽。


Private Sub Label8_Click()
Me.Width = 9180
Me.Height = 11265
Line2.Visible = True
Label5.Left = 9240
Label6.Left = 10560
Text1.Width = 8295
Text2.Left = 9240
Label8.Left = 13920
Label24.Left = 13920
End Sub


左边的‘A’‘B’‘C’‘D’‘E’按钮。调用模块里面的函数。参数来着某个隐藏的文本框。加载数据的时候加载到这些文本框里面,然后在这里作为参数调用自定义的StartDoc函数来调用程序……


'A
Private Sub Label9_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
r = StartDoc(Text4.Text)
Label9.ForeColor = &H8000000F
End Sub

'B
Private Sub Label10_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
r = StartDoc(Text5.Text)
Label10.ForeColor = &H8000000F
End Sub

'C
Private Sub Label11_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
r = StartDoc(Text6.Text)
Label11.ForeColor = &H8000000F
End Sub

'D
Private Sub Label12_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
r = StartDoc(Text7.Text)
Label12.ForeColor = &H8000000F
End Sub

'E
Private Sub Label13_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
r = StartDoc(Text8.Text)
Label13.ForeColor = &H8000000F
End Sub





左边各个字母下方的【EDIT】。用来调用编辑窗口……


'A的
Private Sub Label25_Click() Form2.Show
Form2.Label9.Caption = Me.Label9.Caption
End Sub

'B的
Private Sub Label26_Click() Form2.Show
Form2.Label9.Caption = Me.Label10.Caption
End Sub

'C的
Private Sub Label27_Click()
Form2.Show
Form2.Label9.Caption = Me.Label11.Caption
End Sub

'D的
Private Sub Label28_Click()
Form2.Show
Form2.Label9.Caption = Me.Label12.Caption
End Sub

'E的
Private Sub Label29_Click()
Form2.Show
Form2.Label9.Caption = Me.Label13.Caption
End Sub

'被调用的窗体2根据其标题可以判断是那个按钮按下调用它的。



011.【MIN】最小化

Private Sub Label21_Click()
cSysTray1.InTray = True '隐藏到任务栏
Me.Visible = False
Form2.Visible = False
End Sub


012.【FULL】最大化与简化最大化


Private Sub Label22_Click()

If Label22.Caption = "FUL" Then
Me.Width = Screen.Width
Me.Height = Screen.Height
Me.Top = 10
Me.Left = 10 Picture2.Width = Me.Width - 720
Text1.Width = Screen.Width - 6750
Text2.Left = Screen.Width - 6015
Label5.Left = Text2.Left
Label6.Left = Text2.Left + 1335
Label24.Left = Me.Width - 1335
Label31.Left = Me.Width - 1790
Label8.Left = Me.Width - 1335
'Text3.Width = Me.Width - 2895
Picture4.Width = Me.Width - 1440
Picture1.Width = Me.Width

Else Me.Width = 15360
Me.Height = 11265
Me.Top = 10
Me.Left = 10
Label5.Left = 9240
Label6.Left = 10560
Text1.Width = 8295
Text2.Left = 9240
Label8.Left = 13920
Label24.Left = 13920
Line2.Visible = False
Label31.Left = 13440
Picture4.Width = 13095
End If
If Label22.Caption = "MAX" Then
Label22.Caption = "FUL"
Else
Label22.Caption = "MAX"
End If
End Sub





013.【EXIT】退出

Private Sub Label23_Click() Unload Me
Unload Form2
Unload Form3
Unload Form4
End Sub

014.【移动无标题窗体】


Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then x1 = X: y1 = Y
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then Me.Top = Me.Top + Y - y1: Me.Left = Me.Left + X - x1
End Sub



015.【闪烁标题】


Private Sub Timer1_Timer()
If cl Mod 2 = 0 Then
Label20.ForeColor = &H0&
Form3.Label6.ForeColor = &H0&
Form4.Label6.ForeColor = &H0&
Else
Label20.ForeColor = &HFF00&
Form3.Label6.ForeColor = &HFF00&
Form4.Label6.ForeColor = &HFF00&
End If
cl = cl + 1
If cl = 1000 Then '之前忘记处理这个造成了溢出……
cl = 0
End If
End Sub



016.【双击托盘区图标】


Private Sub cSysTray1_MouseDblClick(Button As Integer, Id As Long)
Me.Visible = True
Me.Show
End Sub


017.【按下按钮时】虽说是按钮倒不如说是标签,只是模拟成按钮。按下改变颜色松开还原颜色,这样就能知道按钮是按下了


Private Sub Label17_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label17.ForeColor = &H8000000F
End Sub

Private Sub Label17_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label17.ForeColor = &HFF00&
End Sub

Private Sub Label31_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label31.ForeColor = &H8000000F
End Sub
Private Sub Label31_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label31.ForeColor = &HFF00&
End Sub


Private Sub Label32_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label32.ForeColor = &H8000000F
End Sub
Private Sub Label32_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label32.ForeColor = &HFF00&
End Sub


Private Sub Label9_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label9.ForeColor = &HFF00& End Sub

Private Sub Label10_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label10.ForeColor = &HFF00&
End Sub
Private Sub Label1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label1.ForeColor = &HFF00&
End Sub
Private Sub Label12_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label12.ForeColor = &HFF00&
End Sub
Private Sub Label13_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label13.ForeColor = &HFF00&
End Sub


018.【文本内容改变,可以保存】

Private Sub Text1_Change()
bcun = True
End Sub




/******************************************************************************************


以上,窗体1完成。


/******************************************************************************************






 楼主| 发表于 2012-4-18 23:17:36 | 显示全部楼层



/******************************************************************************************

窗体2,编辑快捷方式。





/******************************************************************************************



001.【添加文件URL】按钮,打开对话框选择文件


Private Sub Label1_Click()
With CommonDialog1
.DialogTitle = "选择"
.CancelError = False
'ToDo: 设置 common dialog 控件的标志和属性
.Filter = "所有文件 (*.*)|*.*"
.ShowOpen
If Len(.FileName) = 0 Then
Exit Sub
End If
If Label9.Caption = "A" Then
Form1.Text4.Text = .FileName
End If
If Label9.Caption = "B" Then
Form1.Text5.Text = .FileName
End If
If Label9.Caption = "C" Then

Form1.Text6.Text = .FileName
End If
If Label9.Caption = "D" Then

Form1.Text7.Text = .FileName
End If
If Label9.Caption = "E" Then

Form1.Text8.Text = .FileName
End If

End With

End Sub




002.【保存】按钮。


Private Sub Label3_Click()
On Error Resume Next
If Label9.Caption = "A" Then
Form1.Label9.ToolTipText = Text2.Text
Dim FileName1 As String
Dim p1 As String
FileName1 = App.Path & "\erbi\erbi1.dll"
Open FileName1 For Output As #1
p1 = Form1.Text4.Text + Chr(13) + Chr(10) + Form1.Label9.ToolTipText
Print #1, p1
Close #1
End If
If Label9.Caption = "B" Then
Form1.Label10.ToolTipText = Text2.Text
Dim FileName2 As String
Dim p2 As String
FileName2 = App.Path & "\erbi\erbi2.dll"
Open FileName2 For Output As #1
p2 = Form1.Text5.Text + Chr(13) + Chr(10) + Form1.Label10.ToolTipText
Print #1, p2
Close #1
End If
If Label9.Caption = "C" Then
Form1.Label11.ToolTipText = Text2.Text

Dim FileName3 As String
Dim p3 As String
FileName3 = App.Path & "\erbi\erbi3.dll"
Open FileName3 For Output As #1
p3 = Form1.Text6.Text + Chr(13) + Chr(10) + Form1.Label11.ToolTipText
Print #1, p3
Close #1
End If
If Label9.Caption = "D" Then
Form1.Label12.ToolTipText = Text2.Text
Dim FileName4 As String
Dim p4 As String
FileName4 = App.Path & "\erbi\erbi4.dll"
Open FileName4 For Output As #1
p4 = Form1.Text7.Text + Chr(13) + Chr(10) + Form1.Label12.ToolTipText
Print #1, p4
Close #1 End If
If Label9.Caption = "E" Then
Form1.Label13.ToolTipText = Text2.Text

Dim FileName5 As String
Dim p5 As String
FileName5 = App.Path & "\erbi\erbi5.dll"
Open FileName5 For Output As #1
p5 = Form1.Text8.Text + Chr(13) + Chr(10) + Form1.Label13.ToolTipText
Print #1, p5
Close #1
End If
Unload Me
End Sub


/******************************************************************************************


以上,窗体2完成。


/******************************************************************************************




 楼主| 发表于 2012-4-18 23:19:58 | 显示全部楼层



/******************************************************************************************

窗体3,工具……





/******************************************************************************************


000.【全局变量】


Dim x1 As Double
Dim y1 As Double
Dim vHour%, vState$ '时间
Dim a As New Form4
Dim b As New Form4
Dim c As New Form4
Dim d As New Form4 Dim TempFile As Long
Dim LoadBytes() As Byte Dim datname As String



001.【加载窗体】


Private Sub Form_Load()
cSysTray1.InTray = True
GetComputerName_test
Text1.Text = Winsock1.LocalIP
Timer1.Interval = 10
End Sub



002.【当前时间】


Private Sub Timer1_Timer() vHour = Hour(Time)
If vHour > 7 And vHour < 12 Then vState = "上午"
If vHour > 11 And vHour < 13 Then vState = "中午"
If vHour > 12 And vHour < 17 Then vState = "下午"
If vHour > 16 And vHour < 24 Then vState = "晚上"
If vHour > -1 And vHour < 6 Then vState = "凌晨"
If vHour > 4 And vHour < 8 Then vState = "早上"
Label13.Caption = vState & " : " & IIf(Hour(Time) > 12, Hour(Time) Mod 12, Hour(Time)) & ":" & Minute(Time) & ":" & Second(Time)
End Sub




003.【CMD】按钮,调用cmd

Private Sub Label7_Click()
Shell "cmd.exe", vbNormalFocus
End Sub


004.【3389终端】

Private Sub Label9_Click()
Shell "mstsc.exe", vbNormalFocus
End Sub


005.【捆绑器】

Private Sub Label10_Click()
Shell "iexpress.exe", vbNormalFocus
End Sub


006.【信息】

Private Sub Label14_Click()
Form5.Show
End Sub

007.【任务管理器】

Private Sub Label8_Click()
Shell "taskmgr.exe", vbNormalFocus
End Sub

008.【网页】

Private Sub Label17_Click()
Form4.Show
End Sub





009.【端口】

Private Sub Label16_Click()
Form6.Show
End Sub

010.【控制面板】

Private Sub Label15_Click()
Shell "Control.exe", vbNormalFocus
End Sub

011.【注册表】

当时由于测试失败,暂时不用。也就是说这个功能暂缺……





 楼主| 发表于 2012-4-18 23:24:44 | 显示全部楼层


【常用网站】

012.【CMD破解】

Private Sub Label23_Click()
On Error Resume Next
a.Show
a.WebBrowser1.Navigate2 "http://www.xmd5.org/"
a.WebBrowser1.Visible = True
a.Text2.Visible = False
a.Text1 = "http://www.xmd5.org/"
a.Text2.Text = a.Inet1.OpenURL("http://www.xmd5.org/")
End Sub


013.【IP查询】

Private Sub Label24_Click()
On Error Resume Next
b.Show
b.WebBrowser1.Navigate2 "http://www.ip138.com/"
b.WebBrowser1.Visible = True
b.Text2.Visible = False
b.Text1.Text = "http://www.ip138.com/"
b.Text2.Text = b.Inet1.OpenURL("http://www.ip138.com/")
End Sub


014.【免杀检测】

Private Sub Label25_Click()
On Error Resume Next
c.Show
c.WebBrowser1.Navigate2 "http://www.virustotal.com/index.html"
c.WebBrowser1.Visible = True
c.Text2.Visible = False
c.Text1.Text = "http://www.virustotal.com/index.html"
c.Text2.Text = c.Inet1.OpenURL("http://www.virustotal.com/index.html")
End Sub


015.【在线翻译】

Private Sub Label26_Click()
On Error Resume Next
d.Show
d.WebBrowser1.Navigate2 "http://translate.google.cn/#"
d.WebBrowser1.Visible = True
d.Text2.Visible = False
d.Text1.Text = "http://translate.google.cn/#"
d.Text2.Text = d.Inet1.OpenURL("http://translate.google.cn/#")
End Sub



016.【运行日志】

Private Sub Label20_Click()
Frame7.Visible = False
List1.Visible = True
List1.Clear
EnumWindows AddressOf EnumWindowsProc, 0&
End Sub


017.【常用命令】

Private Sub Label21_Click()
Frame7.Visible = True
List1.Visible = False
End Sub


018.【CMD】右边的。加载cmd命令并显示

Private Sub Label39_Click()
Randomize
datname = App.Path & "\erbi\cmd.dll"
If Dir(datname) = "" Then
MsgBox "未找到数据文件", , "提示"

Exit Sub
Else
TempFile = FreeFile
Open datname For Binary As #TempFile
ReDim LoadBytes(1 To LOF(TempFile)) As Byte
Get #TempFile, , LoadBytes
Close TempFile Text3.Text = StrConv(LoadBytes, vbUnicode)
End If
End Sub

019.【bat】

Private Sub Label30_Click() Randomize
datname = App.Path & "\erbi\bat.dll"
If Dir(datname) = "" Then
MsgBox "未找到数据文件", , "提示"

Exit Sub
Else
TempFile = FreeFile
Open datname For Binary As #TempFile
ReDim LoadBytes(1 To LOF(TempFile)) As Byte
Get #TempFile, , LoadBytes
Close TempFile Text3.Text = StrConv(LoadBytes, vbUnicode)
End If
End Sub



020.【扫描工具】

Private Sub Label29_Click()
Randomize
datname = App.Path & "\erbi\smgj.dll"
If Dir(datname) = "" Then
MsgBox "未找到数据文件", , "提示"

Exit Sub
Else
TempFile = FreeFile
Open datname For Binary As #TempFile
ReDim LoadBytes(1 To LOF(TempFile)) As Byte
Get #TempFile, , LoadBytes
Close TempFile Text3.Text = StrConv(LoadBytes, vbUnicode)
End If
End Sub






021.【批处理命令】

Private Sub Label28_Click()
Randomize
datname = App.Path & "\erbi\pichuli.dll"
If Dir(datname) = "" Then
MsgBox "未找到数据文件", , "提示"
Exit Sub
Else
TempFile = FreeFile
Open datname For Binary As #TempFile
ReDim LoadBytes(1 To LOF(TempFile)) As Byte
Get #TempFile, , LoadBytes
Close TempFile
Text3.Text = StrConv(LoadBytes, vbUnicode)
End If
End Sub


022.【运行命令集】


Private Sub Label27_Click()
Randomize
datname = App.Path & "\erbi\yxml.dll"
If Dir(datname) = "" Then
MsgBox "未找到数据文件", , "提示"
Exit Sub
Else
TempFile = FreeFile
Open datname For Binary As #TempFile
ReDim LoadBytes(1 To LOF(TempFile)) As Byte
Get #TempFile, , LoadBytes
Close TempFile
Text3.Text = StrConv(LoadBytes, vbUnicode)
End If
End Sub




023.【FTP】


Private Sub Label37_Click() Randomize
datname = App.Path & "\erbi\ftp.dll"
If Dir(datname) = "" Then
MsgBox "未找到数据文件", , "提示"

Exit Sub
Else
TempFile = FreeFile
Open datname For Binary As #TempFile
ReDim LoadBytes(1 To LOF(TempFile)) As Byte
Get #TempFile, , LoadBytes
Close TempFile Text3.Text = StrConv(LoadBytes, vbUnicode)
End If
End Sub


024.【其它】

Private Sub Label36_Click() Randomize
datname = App.Path & "\erbi\other.dll"
If Dir(datname) = "" Then
MsgBox "未找到数据文件", , "提示"

Exit Sub
Else
TempFile = FreeFile
Open datname For Binary As #TempFile
ReDim LoadBytes(1 To LOF(TempFile)) As Byte
Get #TempFile, , LoadBytes
Close TempFile Text3.Text = StrConv(LoadBytes, vbUnicode)
End If
End Sub






025.【瑞士军刀】

Private Sub Label35_Click() Randomize
datname = App.Path & "\erbi\rsjd.dll"
If Dir(datname) = "" Then
MsgBox "未找到数据文件", , "提示"
Exit Sub
Else
TempFile = FreeFile
Open datname For Binary As #TempFile
ReDim LoadBytes(1 To LOF(TempFile)) As Byte
Get #TempFile, , LoadBytes
Close TempFile
Text3.Text = StrConv(LoadBytes, vbUnicode)
End If
End Sub



026.【ISS服务命令】

Private Sub Label32_Click()
Randomize
datname = App.Path & "\erbi\iss.dll"
If Dir(datname) = "" Then
MsgBox "未找到数据文件", , "提示"
Exit Sub
Else
TempFile = FreeFile
Open datname For Binary As #TempFile
ReDim LoadBytes(1 To LOF(TempFile)) As Byte
Get #TempFile, , LoadBytes
Close TempFile
Text3.Text = StrConv(LoadBytes, vbUnicode)
End If
End Sub


027.【Linux命令】

Private Sub Label31_Click()
Randomize
datname = App.Path & "\erbi\linux.dll"
If Dir(datname) = "" Then
MsgBox "未找到数据文件", , "提示"
Exit Sub
Else
TempFile = FreeFile
Open datname For Binary As #TempFile
ReDim LoadBytes(1 To LOF(TempFile)) As Byte
Get #TempFile, , LoadBytes
Close TempFile
Text3.Text = StrConv(LoadBytes, vbUnicode)
End If
End Sub


028.【IPC+Telnet连接命令】


Private Sub Label31_Click()
Randomize
datname = App.Path & "\erbi\linux.dll"
If Dir(datname) = "" Then
MsgBox "未找到数据文件", , "提示"
Exit Sub
Else
TempFile = FreeFile
Open datname For Binary As #TempFile
ReDim LoadBytes(1 To LOF(TempFile)) As Byte
Get #TempFile, , LoadBytes
Close TempFile
Text3.Text = StrConv(LoadBytes, vbUnicode)
End If
End Sub


029.【MYSQL】


Private Sub Label38_Click()
Randomize
datname = App.Path & "\erbi\mysql.dll"
If Dir(datname) = "" Then
MsgBox "未找到数据文件", , "提示"
Exit Sub
Else
TempFile = FreeFile
Open datname For Binary As #TempFile
ReDim LoadBytes(1 To LOF(TempFile)) As Byte
Get #TempFile, , LoadBytes
Close TempFile
Text3.Text = StrConv(LoadBytes, vbUnicode)
End If
End Sub


030.【命令行嗅探器】


Private Sub Label34_Click()
Randomize
datname = App.Path & "\erbi\mlhxt.dll"
If Dir(datname) = "" Then
MsgBox "未找到数据文件", , "提示"
Exit Sub
Else
TempFile = FreeFile
Open datname For Binary As #TempFile
ReDim LoadBytes(1 To LOF(TempFile)) As Byte
Get #TempFile, , LoadBytes
Close TempFile
Text3.Text = StrConv(LoadBytes, vbUnicode)
End If
End Sub


031.【终端密码破解】


Private Sub Label33_Click()
Randomize
datname = App.Path & "\erbi\zdmmpj.dll"
If Dir(datname) = "" Then
MsgBox "未找到数据文件", , "提示"
Exit Sub
Else
TempFile = FreeFile
Open datname For Binary As #TempFile
ReDim LoadBytes(1 To LOF(TempFile)) As Byte
Get #TempFile, , LoadBytes
Close TempFile
Text3.Text = StrConv(LoadBytes, vbUnicode)
End If
End Sub



其实以上几个使用一个自定义函数,然后使用不同参数进行调用的话会更简洁……



032.【HID】

Private Sub Label41_Click()
Me.Visible = False
End Sub

033.【MIN】

Private Sub Label19_Click()
Me.Width = 5070
End Sub

034。【EXIT】

Private Sub Label18_Click()
Unload Me
Unload Form5
End Sub


035.【从MIN还原】

Private Sub Picture1_Click()
Me.Width = 10845
End Sub


036.【托盘区图标】

Private Sub cSysTray1_MouseDblClick(Button As Integer, Id As Long)
Me.Visible = True
Me.Show
End Sub

037……每一个标签模拟按钮按下效果……就是直接改变颜色……省略,详见源代码……



/******************************************************************************************


以上,窗体3完成。


/******************************************************************************************





 楼主| 发表于 2012-4-18 23:27:33 | 显示全部楼层


/******************************************************************************************

窗体4,网页显示……









/******************************************************************************************


000.【声明】

Dim x1 As Double
Dim y1 As Double
Const SOCKET_ERROR = 0 '以下是检测域名用的,

Private Type WSAdata
wVersion As Integer
wHighVersion As Integer
szDescription(0 To 255) As Byte
szSystemStatus(0 To 128) As Byte
iMaxSockets As Integer
iMaxUdpDg As Integer
lpVendorInfo As Long
End Type

Private Type Hostent
h_name As Long
h_aliases As Long
h_addrtype As Integer
h_length As Integer
h_addr_list As Long
End Type

Private Type IP_OPTION_INFORMATION
TTL As Byte
Tos As Byte
Flags As Byte
OptionsSize As Long
OptionsData As String * 128
End Type

Private Type IP_ECHO_REPLY
Address(0 To 3) As Byte
Status As Long
RoundTripTime As Long
DataSize As Integer
Reserved As Integer
data As Long
Options As IP_OPTION_INFORMATION
End Type

Private Declare Function GetHostByName Lib "wsock32.dll" Alias "gethostbyname" (ByVal HostName As String) As Long
Private Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVersionRequired&, lpWSAdata As WSAdata) As Long
Private Declare Function WSACleanup Lib "wsock32.dll" () As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Declare Function IcmpCreateFile Lib "icmp.dll" () As Long
Private Declare Function IcmpCloseHandle Lib "icmp.dll" (ByVal HANDLE As Long) As Boolean
Private Declare Function IcmpSendEcho Lib "ICMP" (ByVal IcmpHandle As Long, ByVal DestAddress As Long, ByVal RequestData As String, ByVal RequestSize As Integer, RequestOptns As IP_OPTION_INFORMATION, ReplyBuffer As IP_ECHO_REPLY, ByVal ReplySize As Long, ByVal TimeOut As Long) As Boolean


001.【窗体加载】

Private Sub Form_Load()
cSysTray1.InTray = True
End Sub

002.【移动窗体】

Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then x1 = X: y1 = Y
End Sub
Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then Me.Top = Me.Top + Y - y1: Me.Left = Me.Left + X - x1
End Sub



003.【显示网页】


Private Sub Command1_Click()
Command2.Caption = "网页代码"
If Text1.Text <> "" Then
WebBrowser1.Navigate2 Text1.Text
WebBrowser1.Visible = True
Text2.Visible = False
End If
End Sub


004.【网页代码】


Private Sub Command2_Click()
If Command2.Caption = "保存代码 " Then
With CommonDialog1
.Flags = cdlOFNHideReadOnly & cdlOFNOverwritePrompt
.DialogTitle = "保存"
.CancelError = False
'ToDo: 设置 common dialog 控件的标志和属性
.Filter = "所有文件 (*.*)|*.*"
.ShowSave


sfile = .FileName
End With
If sfile = "" Then Exit Sub
FileName = sfile
Open FileName For Output As #1 Print #1, Text2.Text
Close #1
End If
If Command2.Caption = "网页代码" Then
Command2.Caption = "保存代码 "
End If
Text2.Visible = True
Text2.Text = Inet1.OpenURL(Text1.Text)
WebBrowser1.Visible = False
End Sub




005.【检测域名】

Private Sub Command3_Click()

Dim HostName As String
HostName = Text3.Text
Dim hFile&, AddrList&, Address&, rIP$
Dim lpWSAdata As WSAdata, hHostent As Hostent, OptInfo As IP_OPTION_INFORMATION, EchoReply As IP_ECHO_REPLY

Call WSAStartup(&H101, lpWSAdata)

If GetHostByName(HostName + String(64 - Len(HostName), 0)) <> SOCKET_ERROR Then
CopyMemory hHostent.h_name, ByVal GetHostByName(HostName & String(64 - Len(HostName), 0)), Len(hHostent)
CopyMemory AddrList, ByVal hHostent.h_addr_list, 4
CopyMemory Address, ByVal AddrList, 4
End If
hFile = IcmpCreateFile()
If hFile = 0 Then Text4.Text = "检测失败": Exit Sub
OptInfo.TTL = 255
If IcmpSendEcho(hFile, Address, String(32, "A"), 32, OptInfo, EchoReply, Len(EchoReply) + 8, 2000) Then
rIP = CStr(EchoReply.Address(0)) & "." & CStr(EchoReply.Address(1)) & "." & CStr(EchoReply.Address(2)) & "." & CStr(EchoReply.Address(3))
Else
MsgBox "Timeout"
End If
If EchoReply.Status = 0 Then
Text4.Text = HostName & " 的IP地址是: " & rIP & " 共使用 " & CStr(EchoReply.RoundTripTime) & " 毫秒"
Else
Text4.Text = "检测失败 ..."
End If
Call IcmpCloseHandle(hFile)
Call WSACleanup
If Text3.Text = "" Then Text4.Text = "请先输入网址"
End Sub



006.【重新检测】

Private Sub Command4_Click()
Text3.Text = ""
Text4.Text = ""
End Sub



007.【Back】

Private Sub Label10_Click()
On Error Resume Next
WebBrowser1.GoBack
Exit Sub End Sub


008.【Refresh】

Private Sub Label9_Click()
On Error Resume Next
WebBrowser1.Refresh
End Sub


009.【Forward】

Private Sub Label8_Click()
On Error Resume Next
WebBrowser1.GoForward
End Sub

010.【Home】

Private Sub Label11_Click()
WebBrowser1.Navigate2 "www.baidu.com"
WebBrowser1.Visible = True
Text2.Visible = False
End Sub



011.【HID】

Private Sub Label12_Click()
Me.Visible = False
End Sub

012.【MIN】

Private Sub Label7_Click()
Me.Width = 15435
Me.Height = 9900
Text2.Width = 15015
Text2.Height = 7695
WebBrowser1.Width = 15015
WebBrowser1.Height = 7695
Label18.Left = 12720
Label11.Left = 14520
Label8.Left = 14520 End Sub

013.【MAX】

Private Sub Label2_Click()
Me.Width = Screen.Width
Me.Height = Screen.Height
Me.Top = 30
Me.Left = 10 Text2.Width = Screen.Width - 240
Text2.Height = Screen.Height - 120
WebBrowser1.Width = Screen.Width - 240
WebBrowser1.Height = Screen.Height - 120 Label11.Left = Me.Width - 975
Label8.Left = Me.Width - 960
Label18.Left = Me.Width - 960
End Sub

014.【EXIT】

Private Sub Label18_Click()
Unload Me
End Sub



/******************************************************************************************


以上,窗体4完成。


/******************************************************************************************








 楼主| 发表于 2012-4-18 23:29:19 | 显示全部楼层



/******************************************************************************************

窗体5,本机信息……







/******************************************************************************************


000.【就这个……

Private Function OSinfoWMI() As String
Dim tempstr As String
Dim owmi As Object
Dim oitem As Object, citem As Object
Set owmi = GetObject("winmgmts:\\.\root\cimv2")
Set citem = owmi.ExecQuery("Select *from Win32_OperatingSystem")
For Each oitem In citem
tempstr = tempstr & "产品:" & oitem.Manufacturer
tempstr = tempstr & vbCrLf & vbCrLf & "版本类型:" & oitem.BuildType
tempstr = tempstr & vbCrLf & vbCrLf & "安装日期:" & oitem.InstallDate
tempstr = tempstr & vbCrLf & vbCrLf & "产品序列号:" & oitem.SerialNumber
tempstr = tempstr & vbCrLf & vbCrLf & "加密级别(位):" & oitem.EncryptionLevel
tempstr = tempstr & vbCrLf & vbCrLf & "操作系统语言:" & oitem.OSLanguage
tempstr = tempstr & vbCrLf & vbCrLf & "系统驱动器:" & oitem.SystemDrive
tempstr = tempstr & vbCrLf & vbCrLf & "系统文件夹:" & oitem.SystemDirectory
tempstr = tempstr & vbCrLf & vbCrLf & "引导设备:" & oitem.BootDevice
tempstr = tempstr & vbCrLf & vbCrLf & "系统设备:" & oitem.SystemDevice
tempstr = tempstr & vbCrLf & vbCrLf & "最后启动时间:" & oitem.LastBootupTime tempstr = tempstr & vbCrLf & vbCrLf & "运行状态:" & oitem.Status
Next
OSinfoWMI = tempstr
End Function

001.【窗体加载】

Private Sub Form_Load()
Text1.Text = OSinfoWMI
End Sub




/******************************************************************************************


以上,窗体5完成。


/******************************************************************************************




您需要登录后才可以回帖 登录 | 加入天马

本版积分规则

Archiver|手机版|小黑屋|天马行空工作室 ( 京ICP备12003429号  

GMT+8, 2018-11-16 22:37 , Processed in 0.383747 second(s), 23 queries .

Powered by Discuz! v8

© 2010-2014 【VB】--【黑客个人记事本】 - 编程讨论 天马行空工作室

快速回复 返回顶部 返回列表