| |
こんばんは。
セルA1〜A5にa,b,c,d,eと入力したシートをcsv形式で保存しました。
ヘキサダンプを見ると、
61DA
62DA
63DA
64DA
65DA
66DA
となっていますが、これがコンバージョンで
61A
62A
63A
64A
65A
66A
となるようにしました。
'=============================================
Sub main()
Dim flnm
flnm = Application.GetOpenFilename()
If flnm <> False Then
Call コンバージョン_Crなし(flnm)
End If
End Sub
'=============================================
Sub コンバージョン_Crなし(flnm)
Dim flno1 As Long
Dim flno2 As Long
Dim bt() As Byte
Dim bta() As Byte
path = CreateObject("Scripting.FileSystemObject").GetParentFolderName(flnm)
On Error Resume Next
Kill path & "\temp.tmp"
On Error GoTo 0
If open_fl(flno1, flnm) = 0 And open_fl(flno2, path & "\temp.tmp") = 0 Then
If get_fl(flno1, bt()) = 0 Then
jdx = 0
For idx = LBound(bt()) To UBound(bt())
If bt(idx) <> &HD Then
ReDim Preserve bta(jdx)
bta(jdx) = bt(idx)
jdx = jdx + 1
End If
Next
If put_fl(flno2, bta()) <> 0 Then Stop
Call cls_fl(flno1)
Call cls_fl(flno2)
Kill flnm
Name path & "\temp.tmp" As flnm
End If
Call cls_fl(flno1)
Call cls_fl(flno2)
End If
End Sub
'====================================================
Function open_fl(flno As Long, flnm) As Long
On Error Resume Next
flno = FreeFile()
Open flnm For Binary As #flno
open_fl = Err.Number
On Error GoTo 0
End Function
'====================================================
Sub cls_fl(flno As Long)
On Error Resume Next
Close #flno
On Error GoTo 0
End Sub
'=======================================================
Function get_fl(ByVal flno As Long, bt() As Byte) As Long
On Error Resume Next
ReDim bt(LOF(flno) - 1)
Get #flno, , bt()
get_fl = Err.Number
On Error GoTo 0
End Function
'=======================================================
Function put_fl(flno As Long, bt() As Byte) As Long
On Error Resume Next
Put #flno, , bt()
put_fl = Err.Number
On Error GoTo 0
End Function
のmainを実行してみて下さい。上記のようになりました。
ちなみに、ヘキサダンプは以下のコードで確認しました。
'=================================================
Sub disp_fl_dump()
Cells(1, 1).Value = dump()
End Sub
'=================================================
Function dump() As String
Dim buf As String
Dim bt() As Byte
Dim flno As Long
Dim flnm
flnm = Application.GetOpenFilename()
If flnm <> False Then
If open_fl(flno, flnm) = 0 Then
If get_fl(flno, bt()) = 0 Then
dump = ""
For idx = LBound(bt()) To UBound(bt())
dump = dump & Hex(bt(idx))
Next idx
End If
Call cls_fl(flno)
End If
End If
End Function
|
|
ichinose
- 03/9/22(月) 23:46 -
