zxz 15.12.2010 13:45
Predmet:Koristan VB kod

Dao konekcija na mdb bazu.
PreuzmiIzvorni kôd (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

zxz 15.12.2010 13:58
Predmet:Ado konekcija na mdb

Ado Konekcija:
PreuzmiIzvorni kôd (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

zxz 30.04.2011 19:22
Predmet:Dinamicko pokretanje forme

PreuzmiIzvorni kôd (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
PreuzmiIzvorni kôd (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

Gjoreski 14.07.2013 12:33
Predmet:Re: DLookup ,DCount ,DMax ,DMin funkcii

Konekcija so baza vo slucajov MSACCESS baza . Tip na konekcija ADO
PreuzmiIzvorni kôd (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. '---------------------------------------------------------------------------------------


PreuzmiIzvorni kôd (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

zxz 26.07.2013 00:24
Predmet:Datum Fajla

PreuzmiIzvorni kôd (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

Gjoreski 09.08.2013 14:17
Predmet:Funkcija dsum

Funkcija Dsum
PreuzmiIzvorni kôd (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

zxz 12.12.2013 00:50
Predmet:Upload fajla

PreuzmiIzvorni kôd (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

zxz 20.08.2014 12:37
Predmet: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.
PreuzmiIzvorni kôd (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

Avko 07.10.2015 11:06
Predmet:Computer Name i User Name API

modul:
PreuzmiIzvorni kôd (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:
PreuzmiIzvorni kôd (Visual Basic):
  1. Private Sub Command1_Click()
  2.     MsgBox GetUserName & vbNewLine & GetComputerName
  3. End Sub

Avko 07.10.2015 14:26
Predmet: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:
PreuzmiIzvorni kôd (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:
PreuzmiIzvorni kôd (Visual Basic):
  1. Private Sub Command1_Click()
  2.           MsgBox getIP
  3. End Sub