Prikazi cijelu temu 14.03.2011 11:50
zxz Van mreze
Administrator
Registrovan od:03.02.2009
Lokacija:Tuzla


Predmet:Re: Ideje i rjesenja iz teme fiskalizacija
Evo prvi dio provjere pa probaj kako radi.
Znaci provjerava dali je obrisan file.
Drugi dio cemo provjeravati dali je sve ok.
PreuzmiIzvorni kôd (Visual Basic):
  1. Const PutTO = "C:\HCP\TO_FP"
  2. Const PutFrom = "C:\HCP\FROM_FP"
  3.  
  4.  
  5. Function ProvjeraP(BrojRac As String) As String
  6. Dim temp As String
  7. Dim ImeF(1 To 2) As String
  8. Dim fs, R, F
  9. Dim Brojac As Integer
  10. Dim i As Integer
  11.    
  12. BrojRac = "RCP_" & BrojRac & ".XML"  ' Broj rac iz polja me.Me.BROIZD + RCP_ tekst
  13. Provjera1:
  14. Set fs = Application.FileSearch
  15. With fs
  16.     .LookIn = PutTO
  17.     .FileType = 1
  18.     If .Execute > 0 Then
  19.         For i = 1 To .foundfiles.Count
  20.          F = Right(.foundfiles(i), 3)
  21.           If F = "XML" Then
  22.           ImeF(1) = .foundfiles(i)
  23.           ImeF(1) = ImeFajla(ImeF(1))
  24.             If ImeF(1) = BrojRac Then
  25.             DoEvents
  26.             Brojac = Brojac + 1
  27.                If Brojac > 5 Then GoTo Izlaz
  28.                Zaustavi (Brojac)
  29.                GoTo Provjera1
  30.             End If
  31.           End If
  32.         Next i
  33.     End If
  34.  
  35. End With
  36.  
  37. Provjera2:
  38. Set fs = Application.FileSearch
  39. With fs
  40.     .LookIn = PutFrom
  41.     .FileType = 1
  42.     If .Execute > 0 Then
  43.         For i = 1 To .foundfiles.Count
  44.         If Right(.foundfiles(1), 3) = "ERR" Then
  45.         ImeF(2) = ImeFajla(.foundfiles(1))
  46.         ElseIf Right(.foundfiles(1), 2) = "OK" Then
  47.           ImeF(2) = PutTO
  48.           GoTo Kraj
  49.         End If
  50.         Next i
  51.     End If
  52. End With
  53.  
  54. Kraj:
  55. Exit Function
  56. Izlaz:
  57. MsgBox " Ra
  58. un nije oštampan"
  59. GoTo Kraj
  60. End Function
  61.  
  62. Function ImeFajla(PutanjaF As String) As String
  63. '*******************************************
  64. 'Ime:      ImeDir   (Function)
  65. 'Sadržaj: Odvaja ime fajla od putanje
  66. 'Autor:     ZXZ
  67. 'Datum:      09 01, 2010, 11:36:53
  68. 'Adresa: Tuzla BiH
  69. 'Email:     zxz@icentar.ba
  70. 'Ulazni parametri:Putanja
  71. 'Izlazni parametri:Zadnj dir od putanja
  72. '*******************************************
  73.    Dim X As Integer
  74.     Dim Putanja As String
  75.    
  76.     On Error Resume Next
  77. Putanja = PutanjaF
  78. Start:
  79. Do Until Right$(Putanja, 1) = "\"
  80.         Putanja = Left$(Putanja, Len(Putanja) - 1)
  81.  Loop
  82.  ImeFajla = Mid(PutanjaF, Len(Putanja) + 1)
  83. End Function
  84. Function Zaustavi(Trajanje)
  85. Dim Vrijeme
  86.  
  87. DoEvents
  88.  
  89. Trajanje = Trajanje + Timer()
  90. Start:
  91. Vrijeme = Timer()
  92. If Vrijeme < Trajanje Then GoTo Start
  93. End Function
Podrska samo putem foruma, jer samo tako i ostali imaju koristi od toga.