Prikazi cijelu temu 10.02.2015 22:21
zxz Van mreze
Administrator
Registrovan od:03.02.2009
Lokacija:Tuzla


Predmet:Re: VB6 open binary file
e ovo je za ono stihove.
Evo i binarni zapis.
PreuzmiIzvorni kôd (Visual Basic):
  1. Type osoba
  2.     maticniBr As String
  3.     ime As String
  4.     prezime As String
  5.     datumR As String
  6.     adresa As String
  7.     telefon As String
  8. End Type
  9. Type binar
  10.     maticniBr() As Byte
  11.     ime() As Byte
  12.     prezime() As Byte
  13.     datumR() As Byte
  14.     adresa() As Byte
  15.     telefon() As Byte
  16. End Type
  17.  
  18. Function saveBinFile()
  19.     Dim O As osoba
  20.     Dim B As binar
  21.     Dim maticni As Long 'vrijednost kucice
  22.    Dim strSize As Long
  23.     Dim tmp() As Byte
  24.  
  25.     Open "c:\popis.bin" For Binary As #1 'Len = Len(O)
  26.    For f = 1 To 50
  27.         Worksheets("list1").Select
  28.         maticni = Cells(f + 1, 1)
  29.         O.maticniBr = maticni
  30.         O.ime = Cells(f + 1, 2)
  31.         O.prezime = Cells(f + 1, 3)
  32.         O.datumR = Cells(f + 1, 4)
  33.         Worksheets("list2").Select
  34.         O.adresa = Application.WorksheetFunction.VLookup(maticni, Range("A2:e51"), 4, False)
  35.         O.telefon = Str(Application.WorksheetFunction.VLookup(maticni, Range("A2:e51"), 5, False))
  36.         B.adresa = O.adresa
  37.         B.maticniBr = O.maticniBr
  38.         B.ime = O.ime
  39.         B.prezime = O.prezime
  40.         B.datumR = O.datumR
  41.         B.telefon = O.telefon
  42.         Put 1, , B
  43.     Next f 'sljedeci red
  44.    Close 1 'zatvorimo datoteku
  45. End Function
  46.  
  47. Function UcitajRed(KojiRed As Integer)
  48.   Dim RedP As binar 'red podataka za ososubu
  49.  Dim t As osoba
  50.   Dim temp
  51.   Dim I As Integer
  52.  
  53.   Open "c:\popis.bin" For Binary As #1
  54.   For I = 1 To KojiRed
  55.     Get #1, , RedP
  56.   Next I
  57.  temp = Trim(RedP.ime) & " " & Trim(RedP.prezime) & vbCr & "Rodjen: " & Trim(RedP.datumR) _
  58.  & vbCr & "Adresa:" & Trim(RedP.adresa) _
  59.  & vbCr & "Matcini br:" & Trim(RedP.maticniBr) & vbCr & "Tel:" & Trim(RedP.telefon)
  60.   Close #1
  61.   MsgBox temp
  62. End Function
Podrska samo putem foruma, jer samo tako i ostali imaju koristi od toga.