POST, Analise dan Share Code di sini - VBers

[positive+]

Tweet

@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

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,,,,

[FirMan]

Tweet

@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 (*)

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

[positive+]

Tweet

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,

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 )

'============================
' 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,,

[FirMan]

Tweet

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 ?

[positive+]

Tweet

@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 ::
------------

// 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.