[es] - problem sa kodiranjem,pretpostavljam

Eurora3D Team
Nebojsa - Programer & Vodja tima
Beograd

Član broj: 120376
Poruke: 900
91.148.114.*

+7 Profil

Re: problem sa kodiranjem,pretpostavljam

^{04.09.2008. u 13:57 - pre 191 meseci}

@miljanar Aleksandar je u pravu ... fso ne cita pravilno binarne (izgleda da sam previse u c++ ... popustam u VB-u :) )
Ali get cita ... ako se sve uradi ok trebalo bi da radi na VB nacin.
Prepravio sam ovu funkciju u VB stilu ... meni radi isto kao i ona sa Win API-em (sa slikama) a ti proveri te vrednosti koje pominjes
poz

Code:

Private Function CopyHex(CrFile As String, InFile As String, OutFile As String) As Boolean
CopyHex = False

If CrFile = "" Or InFile = "" Or OutFile = "" Then Exit Function
On Error GoTo Err
Dim fSz As Long, I As Long, n As Long, m As Long, b As Boolean
Dim CrBuffer() As Byte, InBuffer() As Byte, OutBuffer() As Byte
Dim hFile As Integer
ReDim CrBuffer(1 To FileLen(CrFile)): ReDim InBuffer(1 To FileLen(InFile)) ': ReDim OutBuffer(1 To FileLen(InFile))
fSz = FileLen(InFile)
'I
hFile = FreeFile
Open CrFile For Binary Access Read Lock Write As #hFile
Get #hFile, , CrBuffer()
Close #hFile
'II
hFile = FreeFile
Open InFile For Binary Access Read Lock Write As #hFile
Get #hFile, , InBuffer()
Close #hFile

'Prepisujemo bajtove i nalazimo ***
n = 0: m = 0
For I = 1 To fSz
If I <= fSz - 127 And m = 0 Then
If InBuffer(I) = CByte(Asc("*")) And InBuffer(I + 127) = CByte(Asc("*")) Then ' mali trik :)
b = True
For n = I To I + 127
If Not Chr(InBuffer(I)) = "*" Then b = False: Exit For
Next n
If b = True Then m = I
End If
End If
'OutBuffer(I) = InBuffer(I) ' koristimo ulazni bufer
Next I
If m = 0 Then Debug.Print "Nemamo niz ****": Exit Function
For I = m To m + 127
'OutBuffer(I) = CrBuffer(I - m + 1)
InBuffer(I) = CrBuffer(I - m + 1) ' prepravicemo ulazni ... bolje nego da koristimo dva bufera
Next I
'III
hFile = FreeFile
Open OutFile For Binary Access Write Lock Write As #hFile
'Put #hFile, , OutBuffer() 'necemo ovaj
Put #hFile, , InBuffer()
Close #hFile

CopyHex = True
Exit Function
Err:
CopyHex = False
Debug.Print "Greska " & Err.Description

End Function

Private Sub Form_Load()
'CrFile je HEX fajl od 128 bajtova, InFile je fajl sa 128 * a OutFile je proizvod gde su zvezdice iz InFile zamenjena sadrzajem HEX fajla
Dim CrFile As String, InFile As String, OutFile As String
CrFile = "": InFile = "": OutFile = "" ' popuniti
If CopyHex(CrFile, InFile, OutFile) Then MsgBox "Ok"
End Sub

HomePage http://www.eurora3d.com

Odgovor na temu