?? 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 + -