Centar za edukaciju-BiH

iCentar → Racunari i oprema → Programirannje i baze podataka → Access


Prosiri i skupi Opcije teme
Stranice (1):1
 Prikazi prvu neprocitanu poruku

#1 24.03.2011 09:59
miro35 Van mreze
Clan
Registrovan od:05.01.2009
Postovi:608


Ocjena: Ocjena:100 Predmet:Gotova rjeÅ¡enja za fiskalne uređaje
Evo primjer računa za HCP uređaje zajedno sa kontrolom (funkcijom) za greÅ¡ke koje se mogu desiti prilikom komunikacije kompjutera i fiskalnog uređaja:
PreuzmiIzvorni kôd (Text):
  1. 'DEFINISANJE PROMENLJIVIH
  2. '...........................
  3. Dim rs2
  4. Dim db As Database
  5. Set Tekst = New Stream
  6. Tekst.Open
  7. Tekst.Position = 0
  8. Tekst.Charset = "UTF-8"
  9. Tekst.WriteText "<?xml version=""1.0"" encoding=""UTF-8"" standalone=""yes""?>" & vbCrLf
  10.  
  11. Tekst.WriteText "<RECEIPT>" & vbCrLf
  12. Set db = CurrentDb()
  13. Set rs2 = db.OpenRecordset("SELECT * FROM qryProba WHERE Broj='" & Me.Broj & "'", dbOpenDynaset)
  14.     Do While Not rs2.EOF
  15.  
  16.  Tekst.WriteText "<" & "DATA BCR" & "=" & """" & rs2!SIFART & """" & " " & "VAT" & "=" & """" & rs2!ArtGPorez & """" & " " & "MES" & "=" & """" & rs2!MES & """" & " " & "DEP=""1"" " & " " & "DSC" & "=" & """" & rs2!ArtNaz & """" & " " & "PRC" & "=" & """" & rs2!Cijena & """" & " " & "AMN" & "=" & """" & rs2!KOLICINASAD & """" & " " & "/>" & vbCrLf
  17.  
  18. rs2.MoveNext
  19.  
  20.     Loop
  21.    
  22.       rs2.Close
  23.      
  24.       Tekst.WriteText "<DATA PAY=""0"" " & "Amount" & "=" & """" & Me.Sveukupno & """" & " " & "/>" & vbCrLf
  25.      
  26.      
  27.    Tekst.WriteText "</" & "RECEIPT" & ">" & vbCrLf
  28.      
  29.  
  30.    
  31.     Set db = Nothing
  32. Tekst.SaveToFile "C:\HCP\TO_FP\RCP_" & Me.BrojRac & ".XML", adSaveCreateOverWrite
  33.  Tekst.Close
  34.  Dim rs4
  35. Dim db4 As Database
  36. Set Tekst4 = New Stream
  37. Tekst4.Open
  38. Tekst4.Position = 0
  39. Tekst4.Charset = "UTF-8"
  40. Tekst4.WriteText "<?xml version=""1.0"" encoding=""UTF-8"" standalone=""yes""?>" & vbCrLf
  41.  
  42.     'Set db4 = Nothing
  43. Tekst4.SaveToFile "C:\HCP\TO_FP\CMD.OK", adSaveCreateOverWrite
  44.  Tekst4.Close
  45.  ProvjeraP (Me.Broj)
Miro
↑  ↓

#2 24.03.2011 10:06
miro35 Van mreze
Clan
Registrovan od:05.01.2009
Postovi:608


Predmet:Re: Gotova rjeÅ¡enja za fiskalne uređaje
Sada ide funkcija za provjeru "ProvjeraP(Me.BrojRacuna).Nju stavimo odmah ispod ovog koda za ispis računa:
PreuzmiIzvorni kôd (Text):
  1.  Function ProvjeraP(BrojRac As String) As String
  2.      Const PutTO = "C:\HCP\TO_FP"
  3.     Const PutFrom = "C:\HCP\FROM_FP"
  4.      
  5.    
  6.     Dim temp As String
  7.     Dim ImeF(1 To 2) As String
  8.     Dim ImeR(1 To 2) As String
  9.     Dim fs, R, F
  10.     Dim Brojac As Integer
  11.     Dim i As Integer
  12.     Dim Putanja_Filea As String
  13.      
  14.    
  15.     ImeR(1) = "RCP_" & BrojRac & ".XML"  ' Broj rac iz polja me.Me.BROIZD + RCP_ tekst
  16. ImeR(2) = "RCP_" & BrojRac & ".ERR"
  17. Provjera1:
  18. Set fs = Application.FileSearch
  19. With fs
  20.     .LookIn = PutTO
  21.     .FileType = 1
  22.     If .Execute > 0 Then
  23.         For i = 1 To .foundfiles.Count
  24.          F = Right(.foundfiles(i), 3)
  25.           If F = "XML" Then
  26.           ImeF(1) = .foundfiles(i)
  27.           ImeF(1) = ImeFajla(ImeF(1))
  28.             If ImeF(1) = ImeR(1) Then
  29.             DoEvents
  30.             Brojac = Brojac + 1
  31.                If Brojac > 3 Then GoTo Izlaz
  32.                Zaustavi (Brojac)
  33.                GoTo Provjera1
  34.             End If
  35.           End If
  36.         Next i
  37.     End If
  38.  
  39. End With
  40.      
  41. Provjera2:
  42. Set fs = Application.FileSearch
  43. With fs
  44.     .LookIn = PutFrom
  45.     .FileType = 1
  46.     If .Execute > 0 Then
  47.         For i = 1 To .foundfiles.Count
  48.         F = Right(.foundfiles(i), 3)
  49.             If F = "ERR" Then
  50.             ImeF(2) = ImeFajla(.foundfiles(i))
  51.                 If ImeF(2) = ImeR(2) Then
  52.                 Putanja_Filea = .foundfiles(i)
  53.                 Close #1
  54.                 Open Putanja_Filea For Input As 1
  55.                 Input #1, temp
  56.                 Close #1
  57.                 MsgBox "GreÅ¡ka:" & temp & "!", vbExclamation, "Ra
  58. un nije fiskaliziran"
  59.                DoCmd.SetWarnings False
  60.             DoCmd.RunSQL "UPDATE Proba SET Nefiskaliziran='" & "-1" & "' WHERE BrojRacuna='" & Forms.frmIZLAZMP.brojRacuna & "'"
  61. DoCmd.SetWarnings True
  62.                 GoTo Kraj
  63.                 End If
  64.             End If
  65.         Next i
  66.     End If
  67. End With
  68.      
  69. Kraj:
  70.  
  71.     Exit Function
  72. Izlaz:
  73.     MsgBox "Ra
  74. un nije ispisan,greška u komunikaciji sa ureajem!", vbExclamation, "Obavijest"
  75.     DoCmd.SetWarnings False
  76.             DoCmd.RunSQL "UPDATE Proba SET Nefiskaliziran='" & "-1" & "' WHERE BrojRacuna='" & Forms.frmIZLAZMP.brojRacuna & "'"
  77. DoCmd.SetWarnings True
  78. BrisiFile (PutTO)
  79.  
  80. GoTo Provjera2
  81.     GoTo Kraj
  82.     End Function
  83.      
  84.     Function ImeFajla(PutanjaF As String) As String
  85.     '*******************************************
  86.     'Ime:      ImeDir   (Function)
  87.     'Sadržaj: Odvaja ime fajla od putanje
  88.     'Autor:     ZXZ
  89.     'Datum:      09 01, 2010, 11:36:53
  90.     'Adresa: Tuzla BiH
  91.     'Email:     zxz@icentar.ba
  92.     'Ulazni parametri:Putanja
  93.     'Izlazni parametri:Zadnj dir od putanja
  94.     '*******************************************
  95.        Dim X As Integer
  96.         Dim Putanja As String
  97.        
  98.         On Error Resume Next
  99.     Putanja = PutanjaF
  100. Start:
  101.     Do Until Right$(Putanja, 1) = "\"
  102.             Putanja = Left$(Putanja, Len(Putanja) - 1)
  103.      Loop
  104.      ImeFajla = Mid(PutanjaF, Len(Putanja) + 1)
  105.     End Function
  106.     Function Zaustavi(Trajanje)
  107.     Dim VRIJEME
  108.      
  109.     DoEvents
  110.      
  111.     Trajanje = Trajanje + Timer()
  112. Start:
  113.     VRIJEME = Timer()
  114.     If VRIJEME < Trajanje Then GoTo Start
  115.     End Function
  116.     Function BrisiFile(Putanja As String)
  117.     Dim fs
  118.     Dim i As Integer
  119.        
  120.     Set fs = Application.FileSearch
  121.     With fs
  122.         .LookIn = Putanja
  123.         .FileType = 1
  124.         If .Execute > 0 Then
  125.             For i = 1 To .foundfiles.Count
  126.             Kill .foundfiles(i)
  127.             Next i
  128.         End If
  129.     End With
  130.     End Function
Miro
↑  ↓

#3 24.04.2011 22:36
adi Van mreze
Clan
Registrovan od:06.02.2011
Postovi:78


Predmet:Re: Gotova rjeÅ¡enja za fiskalne uređaje
vezano za moj raniji post evo koda koji koristim za "izvlačenje" broja fiskalnog računa iz answer fajla za nsc uređaje:

Citat:
Function Broj_Racuna()
Dim temp As String
Dim Poz, Poz2, Poz3 As Integer

Close #1
Open Putanja_Filea For Input As 1
While Not EOF(1)
Line Input #1, temp
If Mid(temp, 1, 2) = "56" Then
Poz = InStr(1, temp, ";")
Poz2 = InStr(Poz + 1, temp, ",")
Poz3 = InStr(Poz2 + 1, temp, ",")
Broj_Racuna2 = Mid(temp, Poz2 + 1, Poz3 - Poz2 - 1)
GoTo kraj:
End If
Wend
kraj:
Close #1
End Function

Izvorni kod primjer
↑  ↓

#4 27.04.2011 10:47
miro35 Van mreze
Clan
Registrovan od:05.01.2009
Postovi:608


Predmet:Re: Gotova rjeÅ¡enja za fiskalne uređaje
JoÅ¡ neÅ¡to bi bilo dobro napraviti naravno ako se može.Neznam da li je kod NSC-a isto ali kod HCP-ovih uređaja u nazivu artikla nemogu se stavljati matematički znakovi a to su (+,-,>,<,%,",/,*).Evo sad je izaÅ¡ao ovaj njihov printer HCP FP555Ba i imao sam ga na testu i odličan je a koÅ¡ta oko 1100KM sa PDV-om.Netreba ni displej jer ima ugrađen u sebi.Ja imam jednu prodavnicu koja ima oko 30000 artikala.Koliko bi trebalo vremena da se izbace ovi gore navedeni znakovi iz naziva artikla u je dnoj tabeli.Da li je moguće napraviti funkciju da izbaci odnosno obriÅ¡e ove znakove iz naziva artikla.Npr tabela je tblArtikli a kolona je ArtNaz.
Miro
↑  ↓

#5 27.04.2011 11:02
miro35 Van mreze
Clan
Registrovan od:05.01.2009
Postovi:608


Predmet:Re: Gotova rjeÅ¡enja za fiskalne uređaje
Možda je ovo rješenje našao sam na internetu ali kao odjednom za sve znakove:
Naz: Replace([ArtNaz];"&";" ")
Ovo znači da kad nadje ovaj znak zamjeni sa praznim mjestom.

Prilozi:
Informacije o tipu datoteke za:rar  replace001.rar
Preuzimanja:523
Velicina datoteke:9.31 KB

Miro
↑  ↓

#6 27.04.2011 11:17
Zuko Van mreze
Clan
Registrovan od:13.09.2010
Postovi:382


Predmet:Re: Gotova rjeÅ¡enja za fiskalne uređaje
evo ovdje imaš nekoliko zxz primjera za ovo je prvi a ostali su iza

http://www.icentar.ba/...ost&id=57
Pozdav,

Nedim
↑  ↓

#7 13.07.2011 11:26
miro35 Van mreze
Clan
Registrovan od:05.01.2009
Postovi:608


Predmet:Re: Gotova rjeÅ¡enja za fiskalne uređaje
Evo sada gotov primjer za HCP uređaje a to su HCP BestBa i HCP FP555Ba.
Primjer sadrži kreiranje xml fajla za ispis računa.
Ima funkciju za kontrolu naziva artikla a to znači ukoliko u nazivu artikla imate znakove:"+*-/& funkcija to ukloni iz naziva.Isto tako ako je naziv duži od 20 mjesta funkcija to skrati na 19 mjesta i na kraju stavi jednu točku.Ukoliko želite da povećate naziv na 32 mjesta jer vam to treba za ovaj pisač FP555Ba onda u tabeli Serials polje BrojZnakova promjenite na 32.
Druga funkcija se zove ProvjeraKlient i ona služi da provjeri da li je račun ispisan na fisk.uređaj.PoÅ¡to nemate spojen uređaj uvjek bi vam javljalo greÅ¡ku odnosno poruku "Račun nije ispisan na fisk.uređaj".
Možete to isključiti u codu na ovom mjestu:
Tekst3.Position = 0
Tekst3.Charset = "UTF-8"
Tekst3.WriteText "<?xml version=""1.0"" encoding=""UTF-8"" standalone=""yes""?>" & vbCrLf

'Set db4 = Nothing
Tekst3.SaveToFile "C:\HCP\TO_FP\CMD.OK", adSaveCreateOverWrite
Tekst3.Close
DoCmd.SetWarnings False
DoCmd.RunSQL "UPDATE tblIzdatnica SET FiskalniIspis='" & "D" & "' WHERE Broj='" & Me.Broj & "'"
DoCmd.SetWarnings True

ProvjeraKlient (Me.Broj)
Ne zaboravite na svom računalu napraviti ove putanje:
C:\HCP\TO_FP
C:\HCP\FROM_FP

Prilozi:
Informacije o tipu datoteke za:rar  ZAHCP.rar
Preuzimanja:588
Velicina datoteke:38.33 KB

Miro
↑  ↓

#8 02.11.2011 09:15
Amelasar Van mreze
Clan
Registrovan od:07.04.2011
Postovi:303


Predmet:Re: Gotova rjeÅ¡enja za fiskalne uređaje
Za TRING uredjaje Favorite Plus i Partner:

Funkcija za izvlacenje broja racuna:
PreuzmiIzvorni kôd (Text):
  1. Function Broj_Racuna(Putanja_Filea As String)
  2. Dim temp As String
  3. Dim Poz(1 To 2) As Integer
  4.  
  5. Close #1
  6. Open Putanja_Filea For Input As #1
  7. While Not EOF(1)
  8. Input #1, temp
  9. Poz(1) = InStr(1, temp, "BrojFiskalnogRacuna")
  10. If Poz(1) > 0 Then
  11. Input #1, temp
  12. Poz(1) = InStr(1, temp, ">") + 1
  13. Poz(2) = InStr(1, temp, "</")
  14. Broj_Racuna = Mid(temp, Poz(1), Poz(2) - Poz(1))
  15. Close #1
  16. GoTo Kraj:
  17. End If
  18. Wend
  19. Kraj:
  20. Close #1
  21. End Function

Funkcija za provjeru odgovora:

PreuzmiIzvorni kôd (Text):
  1. Function Vrsta_Ugovora(Putanja_Filea As String)
  2. Dim temp As String
  3. Dim Poz(1 To 2) As Integer
  4.  
  5. Close #1
  6. Open Putanja_Filea For Input As #1
  7. While Not EOF(1)
  8. Input #1, temp
  9. Poz(1) = InStr(1, temp, "<VrstaOdgovora>")
  10. If Poz(1) > 0 Then
  11. Poz(1) = 16
  12. Poz(2) = InStr(1, temp, "</")
  13. Vrsta_Ugovora = Mid(temp, Poz(1), Poz(2) - Poz(1))
  14. Close #1
  15. GoTo Kraj:
  16. End If
  17. Wend
  18. Kraj:
  19. Close #1
  20. End Function

Funkcija koja se poziva poslije stampanja racuna:

PreuzmiIzvorni kôd (Text):
  1. Function poziv()
  2. Dim Brojac As Integer
  3. Dim Odgovor As String
  4. Dim Brrac As String
  5.  
  6. Pauza1:
  7. Zaustavi (2)
  8. If Brojac > 6 Then GoTo Kraj
  9. On Error Resume Next
  10. Odgovor = Vrsta_Ugovora("c:\_hcp\stampatifiskalniracun.xml")
  11. If Err.Number = 53 Then
  12.     Err.Clear
  13.     On Error GoTo 0
  14.     Brojac = Brojac + 1
  15.     GoTo Pauza1
  16. End If
  17.  
  18. On Error GoTo 0
  19.  
  20. If Odgovor = "Greska" Then
  21.     MsgBox "Raeun nije fiskalizovan!", vbCritical
  22. Else
  23.     Brrac = Broj_Racuna("c:\_tremol\stampatifiskalniracun.11.xml")
  24.     [Forms]![racun].BRF = Brrac
  25.     [Forms]![racun].Fiskalizovan.Value = -1
  26. End If
  27. Izlaz:
  28. Exit Function
  29. Kraj:
  30. MsgBox "Doslo je do greske!"
  31. End Function

Prvo ide provjera odgovora, ako je OK nastavlja dalje uzima broj fiskalnog racuna i u program upisuje da je racun fiskalizovan.

Hvala ZXZ na pomoci.

Pozdrav.
Pozdrav, Amela
↑  ↓

Stranice (1):1

Srodne teme

Ko je online?

Aktivni clanovi:
nema clanova


Kontakt
Sva vremena su GMT +01:00. Trenutno vrijeme: 12: 04 am.