📄 form1.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Form1
BorderStyle = 3 'Fixed Dialog
Caption = "BMP文件中隐藏密文演示"
ClientHeight = 4935
ClientLeft = 45
ClientTop = 330
ClientWidth = 13710
Icon = "Form1.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4935
ScaleWidth = 13710
StartUpPosition = 2 '屏幕中心
Begin VB.PictureBox Picture4
Height = 795
Left = 4860
ScaleHeight = 735
ScaleWidth = 4065
TabIndex = 16
Top = 1770
Visible = 0 'False
Width = 4125
Begin VB.PictureBox Picture5
BackColor = &H00FFFFFF&
Height = 315
Left = 60
ScaleHeight = 255
ScaleWidth = 3945
TabIndex = 18
Top = 390
Width = 4000
Begin VB.PictureBox Picture6
BackColor = &H00FF0000&
BorderStyle = 0 'None
Height = 195
Left = 30
ScaleHeight = 195
ScaleWidth = 15
TabIndex = 19
Top = 30
Width = 15
End
End
Begin VB.Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "正在处理，请稍侯……"
Height = 180
Left = 1050
TabIndex = 17
Top = 120
Width = 1800
End
End
Begin MSComDlg.CommonDialog ComDg
Left = 5640
Top = 1740
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.PictureBox Picture3
Height = 4905
Left = 6870
ScaleHeight = 4845
ScaleWidth = 6735
TabIndex = 8
Top = 0
Width = 6795
Begin VB.CommandButton Command2
Caption = "文件还原"
Enabled = 0 'False
Height = 375
Left = 5760
TabIndex = 14
Top = 4440
Width = 975
End
Begin VB.PictureBox Pic2
AutoSize = -1 'True
Height = 4140
Index = 1
Left = 0
ScaleHeight = 4080
ScaleWidth = 6420
TabIndex = 11
Top = 0
Width = 6480
Begin VB.PictureBox Picture1
AutoSize = -1 'True
Height = 4020
Index = 1
Left = 30
ScaleHeight = 3960
ScaleWidth = 6330
TabIndex = 12
Top = 30
Width = 6390
End
End
Begin VB.HScrollBar HSc
Enabled = 0 'False
Height = 225
Index = 1
LargeChange = 500
Left = 0
Max = 6000
SmallChange = 100
TabIndex = 10
Top = 4170
Width = 6525
End
Begin VB.VScrollBar VSc
Enabled = 0 'False
Height = 4395
Index = 1
LargeChange = 500
Left = 6510
Max = 6000
SmallChange = 100
TabIndex = 9
Top = 0
Width = 225
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "隐藏密文的BMP文件"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 240
Left = 2040
TabIndex = 13
Top = 4500
Width = 2190
End
End
Begin VB.PictureBox Picture2
Height = 4905
Left = 30
ScaleHeight = 4845
ScaleWidth = 6735
TabIndex = 0
Top = 0
Width = 6795
Begin VB.CommandButton Command1
Caption = "隐藏密文"
Enabled = 0 'False
Height = 375
Left = 5820
TabIndex = 15
Top = 4440
Width = 915
End
Begin VB.CommandButton Command4
Caption = "截断处理"
Height = 375
Left = 4890
TabIndex = 7
Top = 4440
Width = 915
End
Begin VB.CommandButton Command3
Caption = "加载BMP"
Height = 375
Left = 3960
TabIndex = 6
Top = 4440
Width = 915
End
Begin VB.VScrollBar VSc
Enabled = 0 'False
Height = 4395
Index = 0
LargeChange = 500
Left = 6510
Max = 6000
SmallChange = 100
TabIndex = 4
Top = 0
Width = 225
End
Begin VB.HScrollBar HSc
Enabled = 0 'False
Height = 225
Index = 0
LargeChange = 500
Left = 0
Max = 6000
SmallChange = 100
TabIndex = 3
Top = 4170
Width = 6495
End
Begin VB.PictureBox Pic2
AutoSize = -1 'True
Height = 4140
Index = 0
Left = 0
ScaleHeight = 4080
ScaleWidth = 6450
TabIndex = 1
Top = 0
Width = 6510
Begin VB.PictureBox Picture1
AutoSize = -1 'True
Height = 3060
Index = 0
Left = 30
Picture = "Form1.frx":030A
ScaleHeight = 3000
ScaleWidth = 5400
TabIndex = 2
Top = 30
Width = 5460
End
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "可隐藏文件约100K。"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 240
Left = 870
TabIndex = 5
Top = 4500
Width = 2325
End
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim endBmpFile As String, cutBmp As Boolean, sbmpFileName As String, HideBMP As String, FileLenb As Long
Private Sub Command1_Click()
Dim BMPBytes() As Byte, sFileBytes() As Byte, BMPLenb As Long
Dim i As Long, n As Long
Picture4.Visible = True
Command4.Enabled = False: On Error GoTo assd
With ComDg
.CancelError = True
.Filter = "*.*|*.*"
.DialogTitle = "选择需要隐藏的文件(系统将同名保存为BMP格式)"
.ShowOpen
endBmpFile = ComDg.FileName
End With
Open endBmpFile For Binary As 1 '待隐藏的文档
Open sbmpFileName For Binary As 2 '源BMP文件。该文件需先进行预处理，已确保每个字节值<=240
FileLenb = LOF(1): BMPLenb = LOF(2)
If BMPLenb < 2 * FileLenb + 36 Then MsgBox "隐藏的文件过长，操作失败！", vbOKOnly + vbCritical, "操作提示": GoTo assd
ReDim BMPBytes(BMPLenb - 1), sFileBytes(FileLenb - 1)
Get #1, , sFileBytes: Get #2, , BMPBytes: Close
HideBMP = Left(endBmpFile, Len(endBmpFile) - 4) & ".bmp"
n = 54
For i = 0 To FileLenb - 1 '对密文处理：一个字节转换为16进制数后，低、高位分别隐藏到BMP的两个字节中
BMPBytes(n) = BMPBytes(n) + (sFileBytes(i) Mod 16) '低位处理
BMPBytes(n + 1) = BMPBytes(n + 1) + (sFileBytes(i) \ 16) '高位处理
n = n + 2: Picture6.Width = i * 3885 \ FileLenb: DoEvents
Next
Open HideBMP For Binary As 3 '隐藏文档的BMP文件
Put #3, , BMPBytes
MsgBox "文档隐藏成功！", vbOKOnly + vbInformation, "系统提示"
Set Picture1(1).Picture = LoadPicture(HideBMP): Command2.Enabled = True
assd: Picture4.Visible = False: Close
PPP: End Sub
Private Sub Command2_Click()
Dim DesFile As String
On Error GoTo errl: Picture4.Visible = True
With ComDg
.CancelError = True: .Filter = "*.*|*.*": .DialogTitle = "文档保存": .ShowSave: DesFile = .FileName
End With
GetFileFromBmp sbmpFileName, HideBMP, DesFile
Command2.Enabled = False
errl: Picture4.Visible = False
End Sub
Private Sub Command3_Click() '加载BMP文件（未截断）
Dim n As Long
Command1.Enabled = False: Command4.Enabled = True
On Error GoTo PPP
With ComDg
.CancelError = True '用户单击“取消”按钮时出错
.Filter = "*.bmp|*.bmp"
.DialogTitle = "加载BMP文件作为密文宿主"
ComDg.ShowOpen
sbmpFileName = ComDg.FileName
Set Picture1(0).Picture = LoadPicture(ComDg.FileName)
End With
Open sbmpFileName For Binary As 1
n = LOF(1)
Close
Label1.Caption = "可隐藏文件约" & n \ 2000 & "K。"
cutBmp = False
PPP: End Sub
Private Sub Command4_Click()
Command1.Enabled = True: Command4.Enabled = False
Dim BMPSourceBytes() As Byte, tpFile As String, BMPLenb As Long, i As Long
If cutBmp Then
MsgBox "文件已作截断处理", vbOKOnly + vbInformation, "系统提示"
Exit Sub
End If
With ComDg
.CancelError = True
.Filter = "*.bmp|*.bmp"
.DialogTitle = "保存已截断的BMP文件"
.ShowSave
On Error GoTo PPP
tpFile = ComDg.FileName
End With
Set Picture1(0).Picture = LoadPicture()
Picture4.Visible = True
Open sbmpFileName For Binary As 1 '未截断的BMP文件
BMPLenb = LOF(1)
ReDim BMPSourceBytes(BMPLenb - 1)
Get #1, , BMPSourceBytes
Close #1
For i = 54 To BMPLenb - 1
If BMPSourceBytes(i) > 240 Then BMPSourceBytes(i) = 240
Next
Open tpFile For Binary As 2 '截断文件的保存
Put #2, , BMPSourceBytes
Close #2
Picture4.Visible = False
Set Picture1(0).Picture = LoadPicture(tpFile)
sbmpFileName = tpFile: cutBmp = True
MsgBox "BMP文件截断成功！", vbOKOnly + vbInformation, "系统提法"
PPP: End Sub
Private Sub Form_Load()
cutBmp = True
sbmpFileName = App.Path & "\good.bmp"
End Sub
Private Sub HSc_Change(Index As Integer)
Picture1(Index).Left = -HSc(Index).Value
End Sub
Private Sub Picture1_Resize(Index As Integer)
Dim nw As Long, nh As Long
nh = Picture1(Index).Height - Pic2(Index).Height: nw = Picture1(Index).Width - Pic2(Index).Width
VSc(Index).Enabled = (nh > 0)
HSc(Index).Enabled = (nw > 0)
If nh > 0 Then
VSc(Index).Max = nh
VSc(Index).LargeChange = nh \ 10: VSc(Index).SmallChange = nh \ 40
End If
If nw > 0 Then
HSc(Index).Max = nw
HSc(Index).LargeChange = nw \ 10: HSc(Index).SmallChange = nw \ 40
End If
End Sub
Private Sub VSc_Change(Index As Integer)
Picture1(Index).Top = -VSc(Index).Value
End Sub
Private Sub GetFileFromBmp(SFile As String, HFile As String, DFile As String)
Dim SBytes() As Byte, HBytes() As Byte, DBytes() As Byte, BmpFileLen As Long
Dim tps As String * 36, n As Long, i As Long, j As Long
Open SFile For Binary As 1 'BMP源
Open HFile For Binary As 2 '隐藏了文档的BMP文件
BmpFileLen = LOF(1): ReDim SBytes(BmpFileLen - 1), HBytes(BmpFileLen - 1), DBytes(FileLenb - 1)
Get #1, , SBytes: Get #2, , HBytes: Close
tps = String(36, "a")
For i = 0 To FileLenb - 1 '每次取两个字节得到密文一个字节
DBytes(i) = 16 * (HBytes(2 * i + 55) - SBytes(2 * i + 55)) + HBytes(2 * i + 54) - SBytes(2 * i + 54)
DoEvents: Picture6.Width = i * 3885 \ FileLenb
Next
Open DFile For Binary As 3
Put #3, , DBytes
Close: Picture4.Visible = False
MsgBox "文档还原成功！", vbOKOnly + vbInformation, "系统提示"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -