Public Sub Main()

    #If Win16 Then

        DBEngine.IniPath = ""

    #Else

        'DBEngine.SystemDB = App.Path & "\sys.mdw"

   #End If

    Set wks = CreateWorkspace("ImePrijekta", "Admin", "")

    Set Db = wks.OpenDatabase(App.Path & "\ImeBaze.mdb")

End Sub

Public Sub Main()

Dim CON As New ADODB.Connection

Dim PATH

 

PATH = App.PATH & "\PutanjaIImeBaze.MDB"

CON.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & PATH & ";Persist Security Info=False"

CON.Open

end sub

Privatni Sub Form_Load ()

S List1

. AddItem "Form1"

. AddItem "Form2"

. AddItem "Form3"

Završiti s

End Sub

Privatni Sub List1_Click ()

Dim frm kao oblik

Dim selForm kao niz

S List1

selForm =. List (. ListIndex)

Završiti s

Set frm = Forms.Add (selForm)

frm.Show

Set frm = Nothing

End Sub

Public cn As ADODB.Connection

cn.ConnectionString = "Driver={Microsoft Access Driver (*.mdb)};" & _

                     "Dbq=VasaBaza.mdb;" & _

                     "DefaultDir=" & App.Path & ";" & _

                     "Uid=Admin;Pwd=;"

'---------------------------------------------------------------------------------------

Public Function DLookup(Pole As String, Tabela As String, Optional ByVal Uslov = "") As Variant

   On Error Resume Next

   Dim rsdl As ADODB.Recordset

   Dim StrSQL As String

   

   If IsNull(Uslov) Or Uslov = "" Then

     StrSQL = "SELECT " & Tabela & "." & Pole & " FROM " & Tabela

   Else

     StrSQL = "SELECT " & Tabela & "." & Pole & " FROM " & Tabela & " WHERE ((" & Tabela & "." & Uslov & "))"

   End If

   Set rsdl = cn.Execute(StrSQL)

   

   If Not (rsdl.EOF And rsdl.BOF) Then

      rsdl.MoveFirst

     'DLookup = rsdl(Pole).Value

     DLookup = rsdl(0).Value

   Else

      DLookup = ""

   End If

   

End Function

 

Public Function DCount(ByVal Pole As String, ByVal Tabela As String, Optional ByVal Uslov = "")

   

   Dim rsdc As ADODB.Recordset

   Dim StrSQL As String

   Dim I As Integer

       I = 0

   If IsNull(Uslov) Or Uslov = "" Then

      StrSQL = "SELECT " & Tabela & "." & Pole & " FROM " & Tabela

   Else

      StrSQL = "SELECT " & Tabela & "." & Pole & " FROM " & Tabela & " WHERE ((" & Tabela & "." & Uslov & "))"

   End If

   Set rsdc = cn.Execute(StrSQL)

   

   If Not (rsdc.EOF And rsdc.BOF) Then

          rsdc.MoveFirst

      Do While Not rsdc.EOF

         I = I + 1

         rsdc.MoveNext

          If rsdc.EOF Then

             Exit Do

          End If

      Loop

  DCount = I

      Exit Function

   Else

     DCount = ""

     Exit Function

   End If

 

End Function

 

Public Function DMax(ByVal Pole As String, ByVal Tabela As String, Optional ByVal Uslov = "")

   ' On Error Resume Next

     Dim rcMax As Recordset

      Dim strMax As String

           

              If IsNull(Uslov) Or Uslov = "" Then

                 strMax = "SELECT Max(" & Tabela & "." & Pole & ") AS MaxVrednost " & " FROM " & Tabela & ""

              Else

                 strMax = "SELECT Max(" & Tabela & "." & Pole & ") AS MaxVrednost " & " FROM " & Tabela & " WHERE (" & Tabela & "." & Uslov & ")"

              End If

       

      Set rcMax = cn.Execute(strMax)

      If IsNull(rcMax!MaxVrednost) Then

         DMax = ""

      Else

         DMax = rcMax!MaxVrednost

      End If

     rcMax.Close

 

 

End Function

 

Public Function DMin(ByVal Pole As String, ByVal Tabela As String, Optional ByVal Uslov = "")

     

      Dim rcMin As ADODB.Recordset

      Dim strMin As String

           

              If IsNull(Uslov) Or Uslov = "" Then

                 strMin = "SELECT Min(" & Tabela & "." & Pole & ") AS MinVrednost " & " FROM " & Tabela & ""

              Else

                 strMin = "SELECT Min(" & Tabela & "." & Pole & ") AS MinVrednost " & " FROM " & Tabela & " WHERE (" & Tabela & "." & Uslov & ")"

              End If

       

      Set rcMin = cn.Execute(strMin)

      If IsNull(DMin = rcMin!MinVrednost) Then

          DMin = ""

      Else

          DMin = rcMin!MinVrednost

      End If

    rcMin.Close

End Function

Function File_Date(strFileName As String) As String

 

On Error GoTo Kraj

       Dim strDate As String

       Dim intcount As Integer

       

       strDate = FileDateTime(strFileName)

       intcount = InStr(1, strDate, " ", vbTextCompare)

       File_Date = CDate(Mid$(strDate, 1, intcount))

Exit Function

Kraj:

MsgBox "Ne postoji Fajl"

End Function

Public Function DSum(ByVal Pole As String, ByVal Tabela As String, Optional ByVal Uslov = "")

   

   Dim rsds As ADODB.Recordset

   Dim StrSQL As String

   Dim Vkupno As Double

       Vkupno = 0

   If IsNull(Uslov) Or Uslov = "" Then

      StrSQL = "SELECT " & Tabela & "." & Pole & " FROM " & Tabela

   Else

      StrSQL = "SELECT " & Tabela & "." & Pole & " FROM " & Tabela & " WHERE ((" & Tabela & "." & Uslov & "))"

   End If

   Set rsds = cn.Execute(StrSQL)

     If rsds.RecordCount = 0 Then

        DSum = ""

        Exit Function

     Else

              rsds.MoveFirst

                 Do While Not rsds.EOF

                    Vkupno = Vkupno + rsds(0).Value

                    rsds.MoveNext

                 Loop

                 DSum = Vkupno

                 Exit Function

     End If

 

End Function

Option Explicit

Private Declare Sub Sleep Lib "kernel32.dll" _

    (ByVal dwMilliseconds As Long)

Private Function UploadFile(ByVal sURL As String _

    , ByVal sUserName As String _

    , ByVal sPassword As String _

    , ByVal sLocalFileName As String _

    , ByVal sRemoteFileName As String) As Boolean

    'Pessimist

   UploadFile = False

    With Inet1

        .UserName = sUserName

        .Password = sPassword

        .Execute sURL, "PUT " & sLocalFileName & " " & sRemoteFileName

        'Mayhaps, a better idea would be to implement

       'StateChanged event handler

       Do While .StillExecuting

            Sleep 100

            DoEvents

        Loop

        UploadFile = (.ResponseCode = 0)

        Debug.Print .ResponseCode

    End With

End Function

Private Sub cmdUpload_Click()

    UploadFile "ftp://localhost", "", "", "C:\Test.txt", "/Level1/Uploaded.txt"

End Sub

Function Trajanje()

 

Static Pocetak As Single

Dim Kraj As Single

Dim Razlika As Single

 

 

If Pocetak = 0 Then

Pocetak = Time

Razlika = Time - Pocetak

Trajanje = Format(Razlika, "HH:NN:SS")

Pocetak = 0

End If

End Function

Declare Function GetComputerNameA Lib "kernel32" (ByVal lpBuffer As String, nSize As Long) As Long

Declare Function GetUserNameA Lib "advapi32.dll" (ByVal lpBuffer As String, nSize As Long) As Long

 

Public Function GetComputerName() As String

Dim sResult As String * 255

    GetComputerNameA sResult, 255

    GetComputerName = Left$(sResult, InStr(sResult, Chr$(0)) - 1)

End Function

 

Public Function GetUserName() As String

Dim UserName As String * 255

    GetUserNameA UserName, 255

    GetUserName = Left$(UserName, InStr(UserName, Chr$(0)) - 1)

End Function

Private Sub Command1_Click()

    MsgBox GetUserName & vbNewLine & GetComputerName

End Sub

Public Function getIP()

    '*******************************

   'ime: getIP (function)

   'autor: Matt Donnan

   'web: http://stackoverflow.com/

   'datum: Dec 7 '12 at 15:21

   '*******************************

   Dim WMI     As Object

    Dim qryWMI  As Object

    Dim Item    As Variant

 

    Set WMI = GetObject("winmgmts:\\.\root\cimv2")

    Set qryWMI = WMI.ExecQuery("SELECT * FROM Win32_NetworkAdapterConfiguration " & _

                               "WHERE IPEnabled = True")

 

    For Each Item In qryWMI

      getIP = Item.IPAddress(0)

    Next

 

    Set WMI = Nothing

    Set qryWMI = Nothing

 

End Function

Private Sub Command1_Click()

          MsgBox getIP

End Sub