POST, Analise dan Share Code di sini - VBers
Welcome guest, is this your first visit? Create Account now to join.
  • Login:

Welcome to the CHIP Forum.

If this is your first visit, be sure to check out the FAQ by clicking the link above. You may have to register before you can post: click the register link above to proceed.

+ Reply to Thread
Page 1 of 51 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 ... LastLast
Results 1 to 10 of 506

Thread: POST, Analise dan Share Code di sini - VBers
  
Bookmark and Share

  1. #1
    Join Date
    Jan 2005
    Posts
    908
    Thanks
    0
    Thanked 9 Times in 8 Posts
    Rep Power
    21

    POST, Analise dan Share Code di sini - VBers



    Gmana kalo thread ini jd code bank vb di chip forums ??
    POST, Analise dan Share Code di sini
    Last edited by positive+; 20-10-2005 at 01:18.
    " A man's felicity consists not in the outward and visible blessing of fortune, but in the inward and unseen perfections and riches of the mind "

    thomas carlyle

    where i used to go when surfing :
    site1 site2 site3 ...


  2. #2
    Join Date
    Jan 2005
    Posts
    908
    Thanks
    0
    Thanked 9 Times in 8 Posts
    Rep Power
    21

    Re: POST, Analise dan Share Code di sini - VBers



    ChangeDatabasePassword
    Database Utility - Ms. Access Database
    Ms. ADO 2.5 Ref

    Full Source Code :
    Code:
    Option Explicit
    
    Const NL = vbNewLine
    Dim Con As Connection
    
    Function file_exist(iFile As String) As Boolean
    Dim a As String
        file_exist = False
        a = Len(Dir(iFile, 0 Or 1 Or 2 Or 32))
        If a > 0 Then file_exist = True
    End Function
    Function secure(iText As String) As String
        iText = Trim(iText)
        secure = Replace(Replace(iText, "'", "`"), "[", "")
    End Function
    Function Change_Pass(Dbpath As String, _
                         OldPass As String, _
                         NewPass As String) As Boolean
    On Error GoTo Junk
    Dim mProv As String, mSql As String
        Change_Pass = False
        If file_exist(Dbpath) = True Then
           mProv = "provider=microsoft.jet.oledb.4.0;Data Source=" & Dbpath
           mSql = "alter database password " & NewPass & " " & OldPass
           Set Con = New Connection
           Con.Mode = adModeShareExclusive
           Con.Open mProv & ";Jet OLEDB:Database Password=" & OldPass & ";"
           Con.Execute mSql
           Con.Close
           Set Con = Nothing
           Change_Pass = True
           Exit Function
        Else
           MsgBox "Database file not found at : " & NL & _
                  Dbpath & NL & "Please check the path again", 0 + 64, "File Not Found"
           Exit Function
        End If
    Junk:
        If Err.Number <> 0 Then
           MsgBox Err.Description, 0 + 48, "Err Found"
           Set Con = Nothing
           Exit Function
        End If
    End Function
    Private Sub Form_Load()
        Move (Screen.Width - Width) / 2, (Screen.Height - Height) / 3
        tNew.TabIndex = 0
    End Sub
    Private Sub cBatal_Click()
        Unload Me
        Set Form1 = Nothing
    End Sub
    Private Sub cUbah_Click()
    Dim sPath As String, sNew As String, sOld As String, ok As Boolean
        sPath = App.Path & "\" & "Test.mdb"
        sNew = secure(tNew.Text)
        sOld = secure(tOld.Text)
        ok = Change_Pass(sPath, sOld, sNew)
        If ok = True Then
           MsgBox "Changes Succeeded ... ", 0 + 64, "Succeeded"
        End If
    End Sub
    Attached Images
    Last edited by positive+; 21-10-2005 at 05:24.

  3. #3
    Join Date
    Jan 2005
    Posts
    908
    Thanks
    0
    Thanked 9 Times in 8 Posts
    Rep Power
    21

    Re: POST, Analise dan Share Code di sini - VBers



    DatabaseTips
    Menampilkan Record - Undocumented Recordset Property
    same functionality with Fields Value Property but more faster

    code
    Code:
    Dim Rs As New Recordset
    Rs.Open "select * from Publishers;", Con, 1, 2
    '/ ref. dengan index column
    mvar = Rs.Collect(1)
    '/ ref. dengan nama column
    mvar = Rs.Collect("Name")
    Last edited by positive+; 21-10-2005 at 05:21.

  4. #4
    Harno Guest

    Re: POST, Analise dan Share Code di sini - VBers



    TextBox tip.....
    clear textbox on form.....

    Code:
    For Each cntl In Form1
        If TypeOf cntl Is TextBox Then cntl.Text = ""
    Next

  5. #5
    Harno Guest

    Re: POST, Analise dan Share Code di sini - VBers



    Blinking label....

    Code:
    Dim lBlink as Boolean
    
    Private Sub Timer1_Timer()
    
    Label1.Visible = lBlink
    
    Timer1.Interval = 500
       If Label1.Visible = False Then
       lBlink = True 
         Else
       Label1.Visible = True
       lBlink = False
       End If
    
    End Sub
    maap masi dalam tahap belajar.... mohon bimbingannya......

  6. #6
    Join Date
    Jan 2005
    Posts
    908
    Thanks
    0
    Thanked 9 Times in 8 Posts
    Rep Power
    21

    Re: POST, Analise dan Share Code di sini - VBers



    InputOnlyNumber
    Block user input utk selain angka

    Dengan menggunakan Function
    Code:
    
    '// No Message appear to user, but they will know what should they do
    '// bila ingin user tidak dapat meng-inputkan angka, jgn beri pesan apa2
    '// Just Block it ... ;) 
    Function BLOCK_KEY(sAscii As Integer) As Integer
        Select Case sAscii
               Case 13
                    BLOCK_KEY = sAscii '/ perbolehkan {ENTER}
               Case 32
                    BLOCK_KEY = sAscii '/ perbolehkan {SPACE}
               Case 8
                    BLOCK_KEY = sAscii '/ perbolehkan {BACKSPACE}
               Case 44
                    BLOCK_KEY = sAscii '/ perbolehkan {,} Comma
               Case 46
                    BLOCK_KEY = sAscii '/ perbolehkan {.} Titik
               Case 48 To 57
                    BLOCK_KEY = sAscii '/ perbolehkan {NUMBER}
               Case Else
                    BLOCK_KEY = 0      '/ Selain dr kriteria di atas block input
        End Select
    End Function
    
    Private Sub Text1_KeyPress(KeyAscii As Integer)
    '// cara penggunaan - usage
        KeyAscii = BLOCK_KEY(KeyAscii)
    End Sub
    
    Dengan menggunakan IsNumeric Function
    Code:
    
    '// ini akan sll menampilkan Pesan ke user utk menginputkan angka
    '// this is do the job, but not user friendly ... thought ;) 
    Private Sub Text1_KeyPress(KeyAscii As Integer)
        If Not IsNumeric(Chr$(KeyAscii)) = True Then
           MsgBox "Please input numerical values", 0 + 48, "Message"
           KeyAscii = 0
        End If
    End Sub
    
    Last edited by positive+; 21-10-2005 at 05:23.

  7. #7
    Join Date
    Jan 2005
    Posts
    908
    Thanks
    0
    Thanked 9 Times in 8 Posts
    Rep Power
    21

    Re: POST, Analise dan Share Code di sini - VBers



    DateManipulation

    Code:
    
    Option Explicit
    
    Const NL = vbNewLine
    '// Now --> Current system time
    Private Sub Command1_Click()
    Dim Buffer As String
        Buffer = Buffer & "Short date -> " & Format(Now, "short date") & NL
        Buffer = Buffer & "Long Date -> " & Format(Now, "long date") & NL
        Buffer = Buffer & "Medium Date -> " & Format(Now, "medium date") & NL
        Buffer = Buffer & "Year -> " & Year(Now) & NL
        Buffer = Buffer & "Month -> " & Month(Now) & NL
        Buffer = Buffer & "Day -> " & Day(Now) & NL
        Buffer = Buffer & "Month in Long Date Format -> " & Format(Now, "mmmm") & NL
        Buffer = Buffer & "Day in Long Date Format -> " & Format(Now, "dddd")
        MsgBox Buffer
    End Sub
    
    Last edited by positive+; 21-10-2005 at 05:24.

  8. #8
    Join Date
    Jan 2005
    Posts
    908
    Thanks
    0
    Thanked 9 Times in 8 Posts
    Rep Power
    21

    Re: POST, Analise dan Share Code di sini - VBers



    Hi Harno, mari kita analise code kamu yg ini ( please, no offence )

    Code:
    
    Private Sub Timer1_Timer()
    '// ini tidak akan pernah di-eksekusi, bila property Interval Timer pd waktu design _
        tetap pada 0
     
       Label1.Visible = lBlink
       '// bila ingin Timer Interval tetap pd 500 ( 0.5 detik )
       Timer1.Interval = 500 '// mengapa ini hrs selalu di-update ?? bukankah lebih baik ditetapkan lgs pd saat design ??
       '// bila ingin Timer Interval di atur dlm coding, Tempatkan -> Timer1.Interval = 500 <- pd event Form_Load
       If Label1.Visible = False Then
          lBlink = True
       Else
          'Label1.Visible = True <-- NOW WE REMOVE THIS LINE
          '// yg kita lakukan hanya update True/False dari var. Boolean lBlink
          '// dgn bgt ini akan sll di-eksekusi oleh line ini -> Label1.Visible = lBlink
          lBlink = False
       End If
       
    End Sub
    
    Now, i would prefer to do this

    Code:
    
    Option Explicit
    
    Dim lBlink As Boolean
    
    Private Sub Form_Load()
        Timer1.Interval = 500 '// set interval ( 0.5 detik )
    End Sub
    Private Sub Timer1_Timer()
       lBlink = Not lBlink '// update Boolean Value for this Varible tiap 0.5 detik
       Label1.Visible = lBlink
    End Sub
    
    Happy coding ...
    Last edited by positive+; 20-10-2005 at 21:58.

  9. #9
    Join Date
    Jan 2005
    Posts
    908
    Thanks
    0
    Thanked 9 Times in 8 Posts
    Rep Power
    21

    Re: POST, Analise dan Share Code di sini - VBers



    SHELLFUNCTION: Menjalankan executable program - basic usage

    sample code

    Code:
    
    Private Sub Command1_Click()
        Shell "explorer", vbNormalFocus '// jalankan Explorer
        Shell "explorer C:\", vbNormalFocus '// jalankan Explorer dgn memberi parameter path C:\
        Shell "explorer mailto:", vbNormalFocus '// email
        Shell "cmd", vbNormalFocus '// command prompt
        Shell "control", vbNormalFocus '// control panel
    End Sub
    
    Last edited by positive+; 21-10-2005 at 05:25.

  10. #10
    Join Date
    Jan 2005
    Posts
    908
    Thanks
    0
    Thanked 9 Times in 8 Posts
    Rep Power
    21

    Re: POST, Analise dan Share Code di sini - VBers



    FileManipulation
    Read File Content - Noobs

    Code:
    
    Option Explicit
    
    'Form dgn sebuah Textbox ( Set property Multiline = True,Scrollbar = 2 - Vertical _
     dan sebuah CommandButton
    
    Enum OpenType
         ByAscii
         ByBinary
    End Enum
    
    Function OpenFile(mFile As String, iType As OpenType, Obj As TextBox)
    'Description : Read File contents _
     mFile       : File Path yang akan dibaca _
     iType       : Tipe Pembacaan ( Ascii / Binary ) _
     Obj         : ByRef Parameter, Isikan dgn nama dr object
    Dim iContent As String, buff As String
        If mFile = "" Then Exit Function
        Select Case iType
               Case ByAscii
                    Open mFile For Input As #1
                         Do Until EOF(1) '// loop s/d end of file
                            Line Input #1, buff '// fill buffer
                            iContent = iContent & buff
                         Loop
                    Close #1
                    Obj.Text = iContent '// show result
               Case ByBinary
                    Open mFile For Binary Access Read As #1
                         iContent = Space(Fix(LOF(1))) '// create space buffer
                         Get #1, , iContent '// get contents of file
                    Close #1
                    Obj.Text = iContent '// show result
        End Select
    End Function
    Private Sub Command1_Click()
    'Usage :
         OpenFile "C:\Logfile.txt", ByBinary, Text1
    End Sub
    
    Last edited by positive+; 21-10-2005 at 05:26.


 

Thread Information

Users Browsing this Thread

There are currently 3 users browsing this thread. (0 members and 3 guests)

     

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts