Bosna i Hercegovina


switch Lista naslova:

#1 15.12.2010-12:45
zxz Online
Administrator
Registrovan/a od: 03.02.2009-16:22
Komentari: 9,418


Subject: Koristan VB kod*
Dao konekcija na mdb bazu.
DownloadIzvorni kod (Visual Basic):
  1. Public Sub Main()
  2.     #If Win16 Then
  3.         DBEngine.IniPath = ""
  4.     #Else
  5.         'DBEngine.SystemDB = App.Path & "\sys.mdw"
  6.    #End If
  7.     Set wks = CreateWorkspace("ImePrijekta", "Admin", "")
  8.     Set Db = wks.OpenDatabase(App.Path & "\ImeBaze.mdb")
  9. End Sub

Potrebno ukljuciti refercu:
\Program Files\Common Files\Microsoft Shared\DAO\DAO350.DLL ili neki drugi
Pozdrav
Ovaj komentar je mijenjan 1 puta. zadnja izmjena 11.12.2013-23:51 od strane zxz. ↑  ↓

#2 15.12.2010-12:58
zxz Online
Administrator
Registrovan/a od: 03.02.2009-16:22
Komentari: 9,418


Subject: Ado konekcija na mdb
Ado Konekcija:
DownloadIzvorni kod (Visual Basic):
  1. Public Sub Main()
  2. Dim CON As New ADODB.Connection
  3. Dim PATH
  4.  
  5. PATH = App.PATH & "\PutanjaIImeBaze.MDB"
  6. CON.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & PATH & ";Persist Security Info=False"
  7. CON.Open
  8. end sub

Pozdrav
Ovaj komentar je mijenjan 1 puta. zadnja izmjena 22.05.2012-23:50 od strane zxz. ↑  ↓

#3 30.04.2011-18:22
zxz Online
Administrator
Registrovan/a od: 03.02.2009-16:22
Komentari: 9,418


Subject: Dinamicko pokretanje forme
DownloadIzvorni kod (Visual Basic):
  1. Privatni Sub Form_Load ()
  2. S List1
  3. . AddItem "Form1"
  4. . AddItem "Form2"
  5. . AddItem "Form3"
  6. Završiti s
  7. End Sub
DownloadIzvorni kod (Visual Basic):
  1. Privatni Sub List1_Click ()
  2. Dim frm kao oblik
  3. Dim selForm kao niz
  4. S List1
  5. selForm =. List (. ListIndex)
  6. Završiti s
  7. Set frm = Forms.Add (selForm)
  8. frm.Show
  9. Set frm = Nothing
  10. End Sub

Pozdrav
↑  ↓

#4 14.07.2013-11:33
Gjoreski Offline
Super Moderator
Registrovan/a od: 02.02.2009-22:24
Komentari: 1,277


Subject: Re: DLookup ,DCount ,DMax ,DMin funkcii
Konekcija so baza vo slucajov MSACCESS baza . Tip na konekcija ADO
DownloadIzvorni kod (Visual Basic):
  1. Public cn As ADODB.Connection
  2. '--------------------------  MsAccess Baza ---------------------------------------------
  3. cn.ConnectionString = "Driver={Microsoft Access Driver (*.mdb)};" & _
  4.                      "Dbq=VasaBaza.mdb;" & _
  5.                      "DefaultDir=" & App.Path & ";" & _
  6.                      "Uid=Admin;Pwd=;"
  7. '---------------------------------------------------------------------------------------


DownloadIzvorni kod (Visual Basic):
  1. Public Function DLookup(Pole As String, Tabela As String, Optional ByVal Uslov = "") As Variant
  2.    On Error Resume Next
  3.    Dim rsdl As ADODB.Recordset
  4.    Dim StrSQL As String
  5.    
  6.    If IsNull(Uslov) Or Uslov = "" Then
  7.      StrSQL = "SELECT " & Tabela & "." & Pole & " FROM " & Tabela
  8.    Else
  9.      StrSQL = "SELECT " & Tabela & "." & Pole & " FROM " & Tabela & " WHERE ((" & Tabela & "." & Uslov & "))"
  10.    End If
  11.    Set rsdl = cn.Execute(StrSQL)
  12.    
  13.    If Not (rsdl.EOF And rsdl.BOF) Then
  14.       rsdl.MoveFirst
  15.      'DLookup = rsdl(Pole).Value
  16.      DLookup = rsdl(0).Value
  17.    Else
  18.       DLookup = ""
  19.    End If
  20.    
  21. End Function
  22.  
  23. Public Function DCount(ByVal Pole As String, ByVal Tabela As String, Optional ByVal Uslov = "")
  24.    
  25.    Dim rsdc As ADODB.Recordset
  26.    Dim StrSQL As String
  27.    Dim I As Integer
  28.        I = 0
  29.    If IsNull(Uslov) Or Uslov = "" Then
  30.       StrSQL = "SELECT " & Tabela & "." & Pole & " FROM " & Tabela
  31.    Else
  32.       StrSQL = "SELECT " & Tabela & "." & Pole & " FROM " & Tabela & " WHERE ((" & Tabela & "." & Uslov & "))"
  33.    End If
  34.    Set rsdc = cn.Execute(StrSQL)
  35.    
  36.    If Not (rsdc.EOF And rsdc.BOF) Then
  37.           rsdc.MoveFirst
  38.       Do While Not rsdc.EOF
  39.          I = I + 1
  40.          rsdc.MoveNext
  41.           If rsdc.EOF Then
  42.              Exit Do
  43.           End If
  44.       Loop
  45.   DCount = I
  46.       Exit Function
  47.    Else
  48.      DCount = ""
  49.      Exit Function
  50.    End If
  51.  
  52. End Function
  53.  
  54. Public Function DMax(ByVal Pole As String, ByVal Tabela As String, Optional ByVal Uslov = "")
  55.    ' On Error Resume Next
  56.      Dim rcMax As Recordset
  57.       Dim strMax As String
  58.            
  59.               If IsNull(Uslov) Or Uslov = "" Then
  60.                  strMax = "SELECT Max(" & Tabela & "." & Pole & ") AS MaxVrednost " & " FROM " & Tabela & ""
  61.               Else
  62.                  strMax = "SELECT Max(" & Tabela & "." & Pole & ") AS MaxVrednost " & " FROM " & Tabela & " WHERE (" & Tabela & "." & Uslov & ")"
  63.               End If
  64.        
  65.       Set rcMax = cn.Execute(strMax)
  66.       If IsNull(rcMax!MaxVrednost) Then
  67.          DMax = ""
  68.       Else
  69.          DMax = rcMax!MaxVrednost
  70.       End If
  71.      rcMax.Close
  72.  
  73.  
  74. End Function
  75.  
  76. Public Function DMin(ByVal Pole As String, ByVal Tabela As String, Optional ByVal Uslov = "")
  77.      
  78.       Dim rcMin As ADODB.Recordset
  79.       Dim strMin As String
  80.            
  81.               If IsNull(Uslov) Or Uslov = "" Then
  82.                  strMin = "SELECT Min(" & Tabela & "." & Pole & ") AS MinVrednost " & " FROM " & Tabela & ""
  83.               Else
  84.                  strMin = "SELECT Min(" & Tabela & "." & Pole & ") AS MinVrednost " & " FROM " & Tabela & " WHERE (" & Tabela & "." & Uslov & ")"
  85.               End If
  86.        
  87.       Set rcMin = cn.Execute(strMin)
  88.       If IsNull(DMin = rcMin!MinVrednost) Then
  89.           DMin = ""
  90.       Else
  91.           DMin = rcMin!MinVrednost
  92.       End If
  93.     rcMin.Close
  94. End Function
↑  ↓

#5 25.07.2013-23:24
zxz Online
Administrator
Registrovan/a od: 03.02.2009-16:22
Komentari: 9,418


Subject: Datum Fajla
DownloadIzvorni kod (Visual Basic):
  1. Function File_Date(strFileName As String) As String
  2.  
  3. On Error GoTo Kraj
  4.        Dim strDate As String
  5.        Dim intcount As Integer
  6.        
  7.        strDate = FileDateTime(strFileName)
  8.        intcount = InStr(1, strDate, " ", vbTextCompare)
  9.        File_Date = CDate(Mid$(strDate, 1, intcount))
  10. Exit Function
  11. Kraj:
  12. MsgBox "Ne postoji Fajl"
  13. End Function

Pozdrav
↑  ↓

#6 09.08.2013-13:17
Gjoreski Offline
Super Moderator
Registrovan/a od: 02.02.2009-22:24
Komentari: 1,277


Subject: Funkcija dsum
Funkcija Dsum
DownloadIzvorni kod (Visual Basic):
  1. Public Function DSum(ByVal Pole As String, ByVal Tabela As String, Optional ByVal Uslov = "")
  2.    
  3.    Dim rsds As ADODB.Recordset
  4.    Dim StrSQL As String
  5.    Dim Vkupno As Double
  6.        Vkupno = 0
  7.    If IsNull(Uslov) Or Uslov = "" Then
  8.       StrSQL = "SELECT " & Tabela & "." & Pole & " FROM " & Tabela
  9.    Else
  10.       StrSQL = "SELECT " & Tabela & "." & Pole & " FROM " & Tabela & " WHERE ((" & Tabela & "." & Uslov & "))"
  11.    End If
  12.    Set rsds = cn.Execute(StrSQL)
  13.      If rsds.RecordCount = 0 Then
  14.         DSum = ""
  15.         Exit Function
  16.      Else
  17.               rsds.MoveFirst
  18.                  Do While Not rsds.EOF
  19.                     Vkupno = Vkupno + rsds(0).Value
  20.                     rsds.MoveNext
  21.                  Loop
  22.                  DSum = Vkupno
  23.                  Exit Function
  24.      End If
  25.  
  26. End Function
Ovaj komentar je mijenjan 1 puta. zadnja izmjena 11.12.2013-23:52 od strane zxz. ↑  ↓

#7 11.12.2013-23:50
zxz Online
Administrator
Registrovan/a od: 03.02.2009-16:22
Komentari: 9,418


Subject: Upload fajla
DownloadIzvorni kod (Visual Basic):
  1. Option Explicit
  2. Private Declare Sub Sleep Lib "kernel32.dll" _
  3.     (ByVal dwMilliseconds As Long)
  4. Private Function UploadFile(ByVal sURL As String _
  5.     , ByVal sUserName As String _
  6.     , ByVal sPassword As String _
  7.     , ByVal sLocalFileName As String _
  8.     , ByVal sRemoteFileName As String) As Boolean
  9.     'Pessimist
  10.    UploadFile = False
  11.     With Inet1
  12.         .UserName = sUserName
  13.         .Password = sPassword
  14.         .Execute sURL, "PUT " & sLocalFileName & " " & sRemoteFileName
  15.         'Mayhaps, a better idea would be to implement
  16.        'StateChanged event handler
  17.        Do While .StillExecuting
  18.             Sleep 100
  19.             DoEvents
  20.         Loop
  21.         UploadFile = (.ResponseCode = 0)
  22.         Debug.Print .ResponseCode
  23.     End With
  24. End Function
  25. Private Sub cmdUpload_Click()
  26.     UploadFile "ftp://localhost", "", "", "C:\Test.txt", "/Level1/Uploaded.txt"
  27. End Sub

Pozdrav
↑  ↓

#8 20.08.2014-11:37
zxz Online
Administrator
Registrovan/a od: 03.02.2009-16:22
Komentari: 9,418


Subject: Vrijem izmedju dva poziva
Ova procedura mjeri vrijeme izmedju dva njena poziva.
Ako je pozovemo na pocetku neke procedure i ponovo na kraju mozemo dobiti vrijeme trajanje te procedure.
DownloadIzvorni kod (Visual Basic):
  1. Function Trajanje()
  2. '*******************************************************
  3. 'Ime:      Trajanje (Function)
  4. 'Sadrzaj:Vremenski raspon izmedju dva poziva
  5. 'Autor: zxz
  6. 'Datum: 20.08.2014, 11:57:48
  7. 'Adresa: Tuzla BiH
  8. 'EMail: zxz@icentar.ba
  9. 'www: icentar.ba
  10. 'Ulazni parametri:Nema
  11. 'Izlazni parametri: Vrijeme
  12. '******************************************************
  13.  
  14. Static Pocetak As Single
  15. Dim Kraj As Single
  16. Dim Razlika As Single
  17.  
  18.  
  19. If Pocetak = 0 Then
  20. Pocetak = Time
  21. Else
  22. Razlika = Time - Pocetak
  23. Trajanje = Format(Razlika, "HH:NN:SS")
  24. Pocetak = 0
  25. End If
  26. End Function

Pozdrav
↑  ↓

#9 07.10.2015-10:06
Avko Offline
Super Moderator
Registrovan/a od: 28.05.2014-09:21
Komentari: 2,570


Subject: Computer Name i User Name API
modul:
DownloadIzvorni kod (Visual Basic):
  1. Declare Function GetComputerNameA Lib "kernel32" (ByVal lpBuffer As String, nSize As Long) As Long
  2. Declare Function GetUserNameA Lib "advapi32.dll" (ByVal lpBuffer As String, nSize As Long) As Long
  3.  
  4. Public Function GetComputerName() As String
  5. '***************************************************************
  6. 'Ime:     GetComputerName   (Function)
  7. 'Sadržaj: daje ime kompjutora
  8. 'Autor:   Gjoreski
  9. '***************************************************************
  10. Dim sResult As String * 255
  11.     GetComputerNameA sResult, 255
  12.     GetComputerName = Left$(sResult, InStr(sResult, Chr$(0)) - 1)
  13. End Function
  14.  
  15. Public Function GetUserName() As String
  16. '***************************************************************
  17. 'Ime:     GetUserName   (Function)
  18. 'Sadržaj: daje ime korisnika
  19. 'Autor:   Gjoreski
  20. '***************************************************************
  21. Dim UserName As String * 255
  22.     GetUserNameA UserName, 255
  23.     GetUserName = Left$(UserName, InStr(UserName, Chr$(0)) - 1)
  24. End Function

poziv:
DownloadIzvorni kod (Visual Basic):
  1. Private Sub Command1_Click()
  2.     MsgBox GetUserName & vbNewLine & GetComputerName
  3. End Sub

Newton laže! Lake padaju brže!
Ovaj komentar je mijenjan 2 puta. zadnja izmjena 07.10.2015-10:15 od strane Avko. ↑  ↓

#10 07.10.2015-13:26
Avko Offline
Super Moderator
Registrovan/a od: 28.05.2014-09:21
Komentari: 2,570


Subject: static IP adresa
Kada se uredaju dodjeli staticna IP adresa ona se ne mijenja. Ona je uvijek ista. Za razliku od staticne IP adrese imamo i dinamic IP adresu koja se dodjeljuje od strane mreze prilikom povezivanja.
Dinamicke IP adrese se tokom vremena mijenjaju.
Staticke IP adrese su potrebne u slucaju kada vanjski uredaji i web stranice trebaju zapamtiti vasu IP adresu.

evo funkcija za prikaz staticne IP adrese:

modul:
DownloadIzvorni kod (Visual Basic):
  1. Public Function getIP()
  2.     '*******************************
  3.    'ime: getIP (function)
  4.    'autor: Matt Donnan
  5.    'web: http://stackoverflow.com/
  6.    'datum: Dec 7 '12 at 15:21
  7.    '*******************************
  8.    Dim WMI     As Object
  9.     Dim qryWMI  As Object
  10.     Dim Item    As Variant
  11.  
  12.     Set WMI = GetObject("winmgmts:\\.\root\cimv2")
  13.     Set qryWMI = WMI.ExecQuery("SELECT * FROM Win32_NetworkAdapterConfiguration " & _
  14.                                "WHERE IPEnabled = True")
  15.  
  16.     For Each Item In qryWMI
  17.       getIP = Item.IPAddress(0)
  18.     Next
  19.  
  20.     Set WMI = Nothing
  21.     Set qryWMI = Nothing
  22.  
  23. End Function

poziv:
DownloadIzvorni kod (Visual Basic):
  1. Private Sub Command1_Click()
  2.           MsgBox getIP
  3. End Sub

Newton laže! Lake padaju brže!
↑  ↓

#11 19.10.2015-13:20
Avko Offline
Super Moderator
Registrovan/a od: 28.05.2014-09:21
Komentari: 2,570


Subject: usporedi dva fajla
Ova funkcija će usporediti jednu datoteke sa drugom. Moze usporediti samo duzinu datoteka ili razliku datoteka byte po byte.
Pozivate je:
usporediDatoteke(File1,File2) - samo za usporediti duzinu datoteka
usporediDatoteku(File1,File2,True) - usporeduje byte po byte datoteka

gdje su File1=App.Path & "/ime1.ext" i File2=App.Path & "/ime2.ext"

DownloadIzvorni kod (Visual Basic):
  1. Function usporediDatoteke(ByVal File1 As String, _
  2.   ByVal File2 As String, Optional StringentCheck As _
  3.   Boolean = False) As Boolean
  4. '*******************************************************************************************
  5. 'Ime: usporediDatoteke
  6. 'Namjena: Provjeri dali su dvije datoteke identicne
  7. 'Autor: Ervin Kosch
  8. 'Ulazni parametri:
  9. '     -File1 i File2  = putanje sa imenom datoteke
  10. '     -StringentCheck = if false (default), usporeduje samo duzinu
  11. '     -StringentCheck = if true , usporeduje byte po byte datoteke
  12. 'Izlazni parametri: Boolean
  13. '********************************************************************************************
  14.  
  15. On Error GoTo ErrorHandler
  16.  
  17. If Dir(File1) = "" Then Exit Function
  18. If Dir(File2) = "" Then Exit Function
  19.  
  20. Dim lLen1 As Long, lLen2 As Long
  21. Dim iFileNum1 As Integer
  22. Dim iFileNum2 As Integer
  23. Dim bytArr1() As Byte, bytArr2() As Byte
  24. Dim lCtr As Long, lStart As Long
  25. Dim bAns As Boolean
  26.  
  27. lLen1 = FileLen(File1)
  28. lLen2 = FileLen(File2)
  29. If lLen1 <> lLen2 Then
  30.     Exit Function
  31. ElseIf StringentCheck = False Then
  32.         usporediDatoteke = True
  33.         Exit Function
  34. Else
  35.     iFileNum1 = FreeFile
  36.     Open File1 For Binary Access Read As #iFileNum1
  37.     iFileNum2 = FreeFile
  38.     Open File2 For Binary Access Read As #iFileNum2
  39.  
  40.     'put contents of both into byte Array
  41.    bytArr1() = InputB(LOF(iFileNum1), #iFileNum1)
  42.     bytArr2() = InputB(LOF(iFileNum2), #iFileNum2)
  43.     lLen1 = UBound(bytArr1)
  44.     lStart = LBound(bytArr1)
  45.    
  46.     bAns = True
  47.     For lCtr = lStart To lLen1
  48.         If bytArr1(lCtr) <> bytArr2(lCtr) Then
  49.             bAns = False
  50.             Exit For
  51.         End If
  52.            
  53.     Next
  54.     usporediDatoteke = bAns
  55.        
  56. End If
  57.  
  58. ErrorHandler:
  59. If iFileNum1 > 0 Then Close #iFileNum1
  60. If iFileNum2 > 0 Then Close #iFileNum2
  61. End Function

Newton laže! Lake padaju brže!
↑  ↓

Stranice (1): 1


All times are GMT +01:00. Current time: 22.09.2017-19:51.