DUMP EDITEUR BINAIRE

Private Declare Function GetFileTime Lib "kernel32" (ByVal hFile&, lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) As Long
Private Declare Function SetFileTime Lib "kernel32" (ByVal hFile&, lpCreationTime As Any, lpLastAccessTime As Any, lpLastWriteTime As Any) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Private Declare Function SetEndOfFile Lib "kernel32" (ByVal hFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Const G_READ = &H80000000
Private Const G_WRITE = &H40000000
Private Const F_SH_READ = 1
Private Const F_SH_W_R = 3
Private Const OPEN_EXISTING = 3
Private Type FILETIME
        LowDateTime As Long 'HighDateTime_LowDateTime=1E7*(SS+60*MN+3600*HH....
        HighDateTime As Long
End Type
Option Explicit
Dim Fil$, LenOfFil&, P&
Dim Cree As FILETIME, Acces As FILETIME, Modif As FILETIME
Dim XX(255) As Byte, DoNot%

Private Function SaveDates%(F$)
Dim H&: H = CreateFile(F, G_READ, F_SH_READ, ByVal 0&, OPEN_EXISTING, vbArchive, 0)
If H <> -1 Then GetFileTime H, Cree, Acces, Modif: CloseHandle H: SaveDates = -1
End Function

Private Sub CutRedate(F$, Optional L&)
Dim H&: H = CreateFile(F, G_WRITE, F_SH_W_R, ByVal 0&, OPEN_EXISTING, 0, 0)
If H <> -1 Then
 If L Then SetFilePointer H, L, 0, 0: SetEndOfFile H
 SetFileTime H, Cree, Acces, Modif: CloseHandle H
End If
End Sub

Private Sub Cherche_Click()
Dim S0$, S1$, I0&, I1&, P0&, L, M%
M = 1 - Check1: S0 = Tscr: If S0 = "" Then Exit Sub
If M Then S0 = UCase(Tscr)
S1 = WS(S0)
If Fil = "" Then Exit Sub
Open Fil For Binary As 1
Dim B$
P0 = P:
Re: L = LenOfFil - P0
If L > 1073741824 Then L = 1073741696: B = Space(1073741824) Else B = Space(L)
Get 1, P0 + 2, B
If M Then B = UCase(B)
I0 = InStr(B, S0): I1 = InStr(B, S1)
If I1 Then If I0 = 0 Or I1 < I0 Then I0 = I1
If I0 Then P = P0 + I0: Close 1: Dump Fil, P
P0 = P0 + L: If P0 < LenOfFil Then GoTo Re
Close 1
End Sub
Private Sub Cherchexa_Click()
Dim S0$, I0&, I1&, P0&, L, B$
If Trim(Thexa) = "" Or Fil = "" Then Exit Sub
S0 = UnH(Thexa)
Open Fil For Binary As 1
P0 = P:
Re: L = LenOfFil - P0
If L > 1073741824 Then L = 1073741696: B = Space(1073741824) Else B = Space(L)
Get 1, P0 + 2, B
I0 = InStr(B, S0)
If I0 Then P = P0 + I0: Close 1: Dump Fil, P
P0 = P0 + L: If P0 < LenOfFil Then GoTo Re
Close 1
End Sub
Private Function UnH$(A$)
Dim B$, I%
B = Trim(Replace(Replace(A, vbCrLf, " "), "  ", " ")) & " "
I = InStr(B, " ")
Do
 UnH = UnH & Chr(Val("&h" & Left(B, I - 1)) And 255)
 B = Mid(B, I + 1)
 I = InStr(B, " ")
Loop While I
End Function

Private Sub CutFil_Click()
Dim L&, A$
If Fil = "" Then Exit Sub
If MsgBox("Etes-vous sûr ?", vbYesNo) = vbNo Then Exit Sub
A = Trim(TxtCut)
If LCase(Left(A, 2)) = "0x" Then
 L = Val("&H" & Mid(A, 3) & "&")
Else
 L = Val(A)
End If
If SaveDates(Fil) Then CutRedate Fil, L: SetLen
End Sub

Private Sub Debut_Click()
P = 0: Dump Fil, P
End Sub

Private Sub Dir1_Click()
File1.Path = Dir1.List(Dir1.ListIndex)
Dossier = File1.Path
End Sub

Private Sub Drive1_Change()
Dir1.Path = UCase(Left(Drive1.Drive, 2)) & "\"
File1.Path = Dir1.Path
End Sub

Private Sub File1_Click()
Fil = File1.Path
If Len(Fil) > 3 Then Fil = Fil & "\"
Fil = Fil & File1.FileName: P = 0
Label2 = Fil: SetLen
P = 0: Dump Fil, P
End Sub

Private Function Max&()
Max = ((LenOfFil - 1) Or 15) - 255: If Max < 0 Then Max = 0
End Function
Private Function WS$(A$)
Dim B() As Byte, I%
If Len(A) Then
 ReDim B(2 * Len(A) - 1)
 For I = 1 To Len(A): B(I + I - 2) = Asc(Mid(A, I, 1)): Next
 WS = StrConv(B, vbUnicode)
End If
End Function

Private Sub Fin_Click()
P = Max: Dump Fil, P
End Sub

Private Sub Form_Load()
Dossier = File1.Path
Dim I%: For I = 0 To 31: XX(I) = 46: Next: For I = 32 To 255: XX(I) = I: Next
End Sub

Private Sub Dump(F$, P&)
If F = "" Then Exit Sub
Dim L&, B() As Byte, I%, J: L = FileLen(F)
Text1 = "": Text2 = "": Text3 = "": Text4 = Hx8(P): AdTxt = Text4
If P >= L Then Exit Sub
If L - P > 256 Then ReDim B(255) Else ReDim B(L - P - 1)
On Error Resume Next
Open F For Binary As 1
If Err Then Text2 = "Accés refusé": Exit Sub
Get 1, P + 1, B: Close 1
For I = 0 To UBound(B) Step 16
Text1 = Text1 & Hx8(P + I) & vbCrLf
For J = I To Inf(UBound(B), I + 15)
Text2 = Text2 & Hx2(B(J)) & " "
Text3 = Text3 & Chr(XX(B(J)))
Next J: Text2 = Text2 & vbCrLf:: Text3 = Text3 & vbCrLf
Next I
End Sub
Private Function Inf(A, B)
If A < B Then Inf = A Else Inf = B
End Function
Private Function Hx2$(B As Byte)
Hx2 = Hex(B): Hx2 = String(2 - Len(Hx2), "0") & Hx2
End Function
Private Function Hx8$(P&)
Hx8 = Hex(P): Hx8 = String(8 - Len(Hx8), "0") & Hx8
End Function

Private Sub Modification_Click()
If Fil = "" Then Exit Sub
If MsgBox("Etes-vous sûr ?", vbYesNo) = vbNo Then Exit Sub
SaveDates Fil
Err.Clear: On Error GoTo xerr
Open Fil For Binary As 1: Put 1, P + 1, UnH(Text2): Close 1
If pd Then CutRedate Fil
xerr: If Err Then Close 1: MsgBox "Impossible de modifier " & Fil
Text4_Keypress 13 'actualisation de la page courante
End Sub

Private Sub ModTxt_Click(I%)
Dim StrMod$, AT&
StrMod = Text5
If Fil = "" Or StrMod = "" Then Exit Sub
If I Then StrMod = StrConv(StrMod, vbUnicode)
AT = Val("&h" & AdTxt & "&")
If AT + Len(StrMod) > LenOfFil Then
 If MsgBox("Hors de la taille du fichier" & vbCrLf & "Ecrire quand même ?", vbYesNo) <> vbYes Then Exit Sub
Else
 If MsgBox("Etes-vous sûr ?", vbYesNo) = vbNo Then Exit Sub
End If
SaveDates Fil
Err.Clear: On Error GoTo xerr
Open Fil For Binary As 1: Put 1, AT + 1, StrMod: Close 1
If pd Then CutRedate Fil
xerr:
If Err Then
 Close 1: MsgBox "Impossible de modifier " & Fil
Else
 SetLen
End If
Text4_Keypress 13 'actualisation de la page courante
End Sub

Private Sub SetLen()
LenOfFil = FileLen(Fil)
TxtCut = "0x" & Hex(LenOfFil)
Longueur = "Longueur: " & LenOfFil & " (" & TxtCut & ")"
Fin.Caption = Hx8(Max)
End Sub

Private Sub plus_Click()
P = Inf(P + 256, Max): Dump Fil, P
End Sub
Private Sub moins_Click()
P = P - 256: If P < 0 Then P = 0
Dump Fil, P
End Sub

Private Sub Text4_Keypress(K%)
If K = 13 Then
P = Inf(Max, Val("&h" & Text4 & "&"))
If P < 0 Then P = 0
Dump Fil, P
End If
End Sub

Private Sub dossier_KeyPress(K%)
If K = 13 Then File1.Path = Dossier: DoNot = -1: Dir1.Path = Dossier: DoNot = 0
End Sub

Private Sub Thexa_Keypress(K%)
If K = 13 Then Cherchexa_Click
End Sub

Private Sub Tscr_Keypress(K%)
If K = 13 Then Cherche_Click
End Sub