Centar za edukaciju-BiH

iCentar → Racunari i oprema → Programirannje i baze podataka → Vb/Vbnet


switch Lista naslova: Koristan VB kod
Prosiri i skupi Opcije teme
Stranice (2):1,2
 Prikazi prvu neprocitanu poruku

#1 15.12.2010 12:45
zxz Van mreze
Administrator
Registrovan od:03.02.2009
Postovi:10,642


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
Podrska samo putem foruma, jer samo tako i ostali imaju koristi od toga.
Ovaj post je ureden 2 puta. Posljednja izmjena 12.10.2021 11:46 od strane zxz. ↑  ↓

#2 15.12.2010 12:58
zxz Van mreze
Administrator
Registrovan od:03.02.2009
Postovi:10,642


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
Podrska samo putem foruma, jer samo tako i ostali imaju koristi od toga.
Ovaj post je ureden 1 puta. Posljednja izmjena 22.05.2012 23:50 od strane zxz. ↑  ↓

#3 30.04.2011 18:22
zxz Van mreze
Administrator
Registrovan od:03.02.2009
Postovi:10,642


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
Podrska samo putem foruma, jer samo tako i ostali imaju koristi od toga.
↑  ↓

#4 14.07.2013 11:33
Gjoreski Van mreze
Administrator
Registrovan od:02.02.2009
Postovi:1,854


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
↑  ↓

#5 25.07.2013 23:24
zxz Van mreze
Administrator
Registrovan od:03.02.2009
Postovi:10,642


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
Podrska samo putem foruma, jer samo tako i ostali imaju koristi od toga.
↑  ↓

#6 09.08.2013 13:17
Gjoreski Van mreze
Administrator
Registrovan od:02.02.2009
Postovi:1,854


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
Ovaj post je ureden 1 puta. Posljednja izmjena 11.12.2013 23:52 od strane zxz. ↑  ↓

#7 11.12.2013 23:50
zxz Van mreze
Administrator
Registrovan od:03.02.2009
Postovi:10,642


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
Podrska samo putem foruma, jer samo tako i ostali imaju koristi od toga.
↑  ↓

#8 20.08.2014 11:37
zxz Van mreze
Administrator
Registrovan od:03.02.2009
Postovi:10,642


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
Podrska samo putem foruma, jer samo tako i ostali imaju koristi od toga.
↑  ↓

#9 07.10.2015 10:06
Avko Van mreze
Administrator
Registrovan od:28.05.2014
Postovi:4,807


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
zivot je moja domovina.
Ovaj post je ureden 2 puta. Posljednja izmjena 07.10.2015 10:15 od strane Avko. ↑  ↓

#10 07.10.2015 13:26
Avko Van mreze
Administrator
Registrovan od:28.05.2014
Postovi:4,807


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
zivot je moja domovina.
↑  ↓

Stranice (2):1,2

Srodne teme

Ko je online?

Aktivni clanovi:
nema clanova


Kontakt
Sva vremena su GMT +01:00. Trenutno vrijeme: 1: 13 am.