POST, Analise dan Share Code di sini - VBers - Page 51
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 51 of 51 FirstFirst ... 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51
Results 501 to 506 of 506

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

  1. #501
    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



    @Firman,

    gk perlu pake FSO, here it is ... i wrote t code with no handle error, you'll find ur self out of it later ...

    - FORM WITH,,
    - LISTBOX
    - COMMAND BUTTON

    Code:
    Option Explicit
    
    Private Const FILE_ATTRIBUTE_DIRECTORY  As Long = &H10
    Private Const PATH_SEPARATOR            As String = "\"
    Private Const KILO                      As Long = 1024
    
    Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
    Private Declare Function PathIsDirectory Lib "shlwapi.dll" Alias "PathIsDirectoryA" (ByVal pszPath As String) As Long
    
    Private Type FILE_STRUCT
            oFullPathFilename   As String
            oFilenameOnly       As String
            oFilesizeInBytes    As Double
            oFilesizeInKilos    As Double
    End Type
    
    Private FileCollections()   As FILE_STRUCT
    Private cnt                 As Long
    
    Private Function GetAllFiles(ByVal strFolder As String, _
                                 Optional strSearch As String = "*.*")
    Dim sFilename           As String
    Dim lngIsDir            As Long, lngDirWithFiles As Long
        If (strFolder = "") Then Exit Function
        strFolder = IIf(Right(strFolder, 1) <> PATH_SEPARATOR, strFolder & PATH_SEPARATOR, strFolder)
        lngIsDir = PathIsDirectory(strFolder)
        If (lngIsDir) Then
                Erase FileCollections
                cnt = -1
                sFilename = Dir(strFolder & strSearch, vbDirectory)
                Do While sFilename <> ""
                    If GetFileAttributes(strFolder & sFilename) <> FILE_ATTRIBUTE_DIRECTORY Then
                        
                           Debug.Print sFilename
                           cnt = cnt + 1
                           ReDim Preserve FileCollections(cnt)
                           With FileCollections(cnt)
                                .oFullPathFilename = strFolder & sFilename
                                .oFilenameOnly = sFilename
                                .oFilesizeInBytes = FormatNumber(FileLen(strFolder & sFilename), 2)  ' dalam BYTES
                                .oFilesizeInKilos = FormatNumber(FileLen(strFolder & sFilename) / KILO, 2)
                           End With
                        
                    End If
                    sFilename = Dir
                Loop
        End If
    End Function
    
    Private Sub Command1_Click()
    Dim i As Long
        Call GetAllFiles("C:\windows\system32", "*.*")
        If (cnt > -1) Then
            List1.Clear
            For i = 0 To cnt
                List1.AddItem FileCollections(i).oFilenameOnly & vbTab & FileCollections(i).oFilesizeInBytes & " Bytes" & vbTab & vbTab & FileCollections(i).oFilesizeInKilos & " KBytes"
            Next i
        End If
    End Sub
    
    Private Sub Form_Unload(Cancel As Integer)
        Erase FileCollections()
    End Sub
    8 minutes to code it ..
    now, what U NEED TO DO is to FILTERED EM OUT AS U LIKED TO BE ... THATS SHOULD BE EASY, SINCE I'M COLLECTING EM IN STRUCTURING DATA THERE ...
    use ur imaginations @Firman,
    enjoy,,,,
    Last edited by positive+; 23-04-2012 at 03:01.
    " 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. The Following User Says Thank You to positive+ For This Useful Post:

    FirMan (14-04-2012)

  3. #502
    Join Date
    Oct 2004
    Location
    Kota Kembang
    Posts
    2,588
    Thanks
    350
    Thanked 112 Times in 89 Posts
    Rep Power
    27

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



    Quote Originally Posted by positive+ View Post
    @Firman,
    8 minutes to code it ..
    now, what U NEED TO DO is to FILTERED EM OUT AS U LIKED TO BE ... THATS SHOULD BE EASY, SINCE I'M COLLECTING EM IN STRUCTURING DATA THERE ...
    use ur imaginations @Firman,
    enjoy,,,,
    wah iya kang nuhun pisan, kudu sering latihan nih ...
    practices make better he3x sering2 banyakin jam terbang
    dengan kasus2 baru

    btw ada masalah baru di koneksi database, ane pk firebird.
    mungkin bisa bantu nih tiba2 muncul runtime error 91 di query select count (*)

    Code:
    Public cnn As New ADODB.Connection
    Public rst As New ADODB.Recordset
    Public cmd As New ADODB.Command
    Public sql As String
    
    Public Sub BukaKoneksi()
        If cnn.State = adStateOpen Then cnn.Close
            Set cnn = Nothing
            Set rst = Nothing
            Set sql = Nothing
        cnn.Mode = adModeReadWrite
        cnn.CursorLocation = adUseClient
        cnn.Open "Driver={Firebird/InterBase(r) driver};Uid=SYSDBA;Pwd=maskey789; DbName=" & App.Path & "\dBase\dbMASTER.fdb;"
    End Sub 
    
    Sub LoadData()
        call BukaKoneksi
        rst.Open "SELECT COUNT (*) AS ada FROM m_data_t",cnn
    End Sub
    error di query select count (*) padahal sebelumnya ga masalah
    muncul pesan:

    Run-time error '91':

    Object variable or With block variable not set

  4. #503
    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



    beberapa hari ini baru selesai'in project untuk remote application.
    jadi kemungkinan beberapa waktu ke depan sulit OL.

    okey then,,wah ... wah .. hmmm...

    PERHATIKAN UNTUK TANDA COMMENT PADA CODING DI BAWAH INI YAH ...
    KURANG TELITI @Firman nya,

    Code:
    Public cnn As New ADODB.Connection '// OBJECT 
    Public rst As New ADODB.Recordset '// OBJECT  
    Public cmd As New ADODB.Command '// OBJECT 
    Public sql As String ' NOT OBJECT !!  
    
    Public Sub BukaKoneksi()     
        If cnn.State = adStateOpen Then 
           cnn.Close '// NOT SAFE CODE --         
           Set cnn = Nothing '// OK .. DESTROY OBJECT [ LOC - ATTENTION ]         
           Set rst = Nothing '// OK .. DESTROY OBJECT         
           Set sql = Nothing '// DI SINI HARUSNYA ERROR !
          '// DI SINI SUDAH ERROR -  var cnn IS NIL / NULL -
          '=====================
          ' ADD CODE
          '---------------------
        set cnn = new adodb.connection  
        cnn.Mode = adModeReadWrite     
        cnn.CursorLocation = adUseClient     
        cnn.Open "Driver={Firebird/InterBase(r) driver};Uid=SYSDBA;Pwd=maskey789; DbName=" & App.Path & "\dBase\dbMASTER.fdb;" 
    End Sub   
    
    Sub LoadData()     
         call BukaKoneksi     
         rst.Open "SELECT COUNT (*) AS ada FROM m_data_t",cnn 
    End Sub
    udah tau kan salahnya dimana :-)

    here,,some modification code using ur idea of code ( just add some checked function )

    Code:
    '============================
    ' YOUR VARS
    '----------------------------
    'IF THIS VAR JUST IN THIS FORM - USE [ PRIVATE ] RATHER THAN [ PUBLIC ]
    '----------------------------
    Public cnn As New ADODB.Connection '// OBJECT
    Public rst As New ADODB.Recordset '// OBJECT
    Public cmd As New ADODB.Command '// OBJECT
    Public sql As String ' NOT OBJECT !!
    '============================
    ' ADDITIONS
    '----------------------------
    Const USER_DBNAME    As String = "SYSDBA" '// SHOULD BE ENCRYPTED - OR MANY OTHER WAYS WE CAN THINK OF :-)
    Const USER_DBPWD     As String = "maskey789" '// SHOULD BE ENCRYPTED
    
    Private Function FileExist(ByVal s As String) As Boolean
        If (Len(s) > 0) Then
            FileExist = Len(Dir(s, vbNormal)) > 0
        End If
    End Function
    
    '// IF THIS CODE JUST IN THIS FORM - USE [ PRIVATE ] RATHER THAN [ PUBLIC ]
    Public Function BukaKoneksi(ByVal strUserName As String, ByVal strPassword As String, _
                                ByVal strPathDB As String) As Boolean
    Dim ok  As Boolean
    On Error GoTo TrapErr
        '// JUST ACCORDING UR CODE LOGIC HERE + ERR HANDLER
        '// hanya di sini username dan password harus terisi, prioritas harus dipertimbangkan, tergantung kebutuhan
        If (strUserName <> "" And strPassword <> "") Then
            If (FileExist(strPathDB)) Then
                If (cnn Is Nothing) Then Set cnn = New ADODB.Connection
                If (cnn.State = adStateOpen) Then cnn.Close
                With cnn
                     .CursorLocation = adUseClient
                     .Mode = adModeReadWrite
                     .Open "Driver={Firebird/InterBase(r) driver};" & _
                           "Uid=" & strUserName & ";" & _
                           "Pwd=" & strPassword & ";" & _
                           "DbName=" & strPathDB
                     ok = (.State = adStateOpen)
                End With
            End If
        End If
    ExitPoint:
        BukaKoneksi = ok
        Exit Function
    TrapErr:
        ok = False
        Debug.Print "ERR ON BukaKoneksi() - " & Err.Description
        On Error GoTo 0
        Err.Clear
        Resume ExitPoint
    End Function
    
    '// IF THIS CODE JUST IN THIS FORM - USE [ PRIVATE ] RATHER THAN [ PUBLIC ]
    Public Function LoadData(ByRef lngDataCount As Long) As Boolean
    Dim ok  As Boolean
    On Error GoTo TrapErr
        If (BukaKoneksi(USER_DBNAME, USER_DBPWD, YourVarDatabasePath)) Then
            rst.Open "SELECT COUNT (*) AS ada FROM m_data_t", cnn
            If (Not rst Is Nothing) Then            
                lngDataCount = rst.fields(0).value
                Set rst = Nothing
                ok = True
            End If
        End If
    ExitPoint:
        LoadData = ok
        Exit Function
    TrapErr:
        ok = False
        Debug.Print "ERR ON LoadData() - " & Err.Description
        On Error GoTo 0
        Err.Clear
        Resume ExitPoint
    End Function
    
    Private Sub Form_Load()
    Dim lngRecordCount  As Long
        If (LoadData(lngRecordCount)) Then
            MsgBox "Query OK. Return " & CStr(lngRecordCount) & " record(s)"
        End If
    End Sub
    cheers,,
    Last edited by positive+; 23-04-2012 at 03:14.

  5. The Following User Says Thank You to positive+ For This Useful Post:

    FirMan (25-04-2012)

  6. #504
    Join Date
    Oct 2004
    Location
    Kota Kembang
    Posts
    2,588
    Thanks
    350
    Thanked 112 Times in 89 Posts
    Rep Power
    27

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



    Lagi butuh bantuan lagi nih, mw buat keygen hasil randomize
    sederhana seperti gambar interface berikut



    cara kerjanya :
    1. pass id muncul secara random setiap program keygen di buka
    2. pass key dihasilkan / di generate dari program terpisah
    3. hasil dari pass key dimasukkan kedalam text box pass key di program keygen diatas
    4. ketika tombol ok di klik akan memunculkan pesan valid jika hasil pass key sesusai dengan pass id

    jadinya ada 2 program: generate dan validasi
    cuma masih bingung syntax, apa ada yg pernah buat project ini ?

  7. #505
    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



    @firman :: ma'af baru balas,

    to take a look --> http://www.schneier.com/cryptography.html
    ---------------------------

    logic based on ur ideas ::
    ---------------------------
    gunakan *.DLL untuk create dan validate
    references main prog ke *.DLL

    main-prog ::
    ------------
    Code:
    // private in general section
    var $key 
    var $temp
    
    dll__function.generatedkeyused(){
    
    $ky_temp_used ::__get_bookmark_last_key_used___(base FILE || ETC )
    $ky_temp_used ::__random_result_key_used();
    
    __save_bookmark_key_used
    
    $key = $ky_temp_used
    return $key
    
    }
    
    dll__function.generated(){
    
          call_out :: dll__function.generatedkeyused()
    
          $gen :: __rnd_crypt_generated_used_key($key)
    
          return $gen
    
    }
    
    local__dll__function.getkeypattern($input){
          return $key_pattern_found
    }
    
    dll__function.creates(){
        $temp :: dll__function.generated()
        return $temp
    }
    
    dll__function.validates($usr_input){
        $ky_pattern :: local__dll__function.getkeypattern($usr_input)
        $bool_ret :: ( $ky_pattern == $key )
        return $bool_ret
    }
    ma'af bahasanya bukan vb ato lainnya, just point some code logic.

  8. The Following User Says Thank You to positive+ For This Useful Post:

    FirMan (11-04-2013)

  9. #506
    Join Date
    Oct 2004
    Location
    Kota Kembang
    Posts
    2,588
    Thanks
    350
    Thanked 112 Times in 89 Posts
    Rep Power
    27

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



    master vb mw tanya nih buat thread di vb6
    buat progress bar kadang klihatan/dikirain hang oleh user
    ada bebrapa referensi pakai dotnet 2.0 dan powerbasic

    Using Background Threads with Visual Basic 6
    http://msdn.microsoft.com/en-us/libr...(v=vs.71).aspx

    Multi-Threading for Basic Programmers
    http://www.powerbasic.com/support/te...threading1.asp

    munkin ada yg lebih mudah lagi ?

    untuk yg menggunakan dotnet 2.0 ada file library NetFX20Wrapper
    apa ada cara lain agar bisa di gabung dgn vb6
    tanpa harus di build di visual studio


 

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 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