Announcement

Announcement Module
Collapse
No announcement yet.

POST, Analise dan Share Code di sini - VBers

Page Title Module
Move Remove Collapse
This is a sticky topic.
X
X
Conversation Detail Module
Collapse
  • Filter
  • Time
  • Show
Clear All
new posts

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

    immediated value setup pada textbox untuk formatting pada saat _change akan membuat kursor berada sel text akhir, saat :
    Code:
    text1.text = _funct(text1.text)
    untuk keperluan itu ada control khusus yang dpt digunakan : maskedbox (masked edit box)

    bila untuk mempertahankan kesederhanaan, maka event yg cocok pd standard textbox dapat salah satu dari event ini :

    Lost_Focus : saat fokus berpindah ke control lainnya
    atau
    Validate : validasi _after change. Bila ekspression pada section code event validate itu mengembalikan FALSE maka fokus akan tetap pada control hingga TRUE, hal ini di trigger melalui parameter byref Cancel pd event tersebut.

    saya sendiri lebih prefer kepada LostFocus ( utk lebih simple ) / exit ( pada .NET )

    untuk menghindari _kesalahan pembacaan_ oleh code mengenai value dari textbox itu sendiri setelah diformat, maka sebelum melakukan format akhir, dikembalikan terlebih dahulu ke default text.

    Code:
    function formattextnumber( byval strdata as string ) as string
         strdata = format(format(strdata,""),"##,###,##0.00")  rem ATAU, strdata = format(format(strdata,""),"##,###,###,##0.00")
         formattextnumber = strdata
    end function
    hmm..mengenai format sendiri :
    explain per-segment :

    ##0 : bila nilai pada segment tersebut adalah 12 , maka akan otomatis ditambahkan 0 hingga bila nilai 12 pada segment tsb , akan menjadi 120.
    .00 : untuk desimal value, bila tidak ada nilai desimal, placeholder itu akan tetap berisikan 00.
    untuk kebutuhan nilai yang tidak terlalu besar maka cukup menggunakan format :

    Code:
    format(format(strdata,""),"##,##0.00")
    bila tidak menginginkan desimal

    Code:
    format(format(strdata,""),"##,##0")
    untuk penggunaan dari function itu sendiri,

    Code:
    private sub text1_lostfocus()
         text1.text = formattextnumber(text1.text)
    end sub
    bila menginginkan immediated setup, gunakan maskedbox ( dalam code akan perlu tambahin ini itu lagi dan melelahkan bila hanya untuk pencapaian tujuan yg sederhana )

    opsi lainnya, dapat gunakan pada event _lostfocus seperti di atas.

    regard,
    Last edited by positive+; 05-01-2012, 15:17.

    Comment


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

      Hidden


      Cukup sederhana tapi karena ini membuat user lebih
      berhati-hati sebelum menekan tombol enter karena
      takut kelebihan digit waktu cash end atau clerek setoran

      Tadinya pk on keypress btw ane coba pakai dulu pakai
      masked edit.

      Nuhun kang bro penjelasannya sangat komprehensif.

      Comment


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

        Kang bro2

        Mw tanya soal Set Object Nothing, bagaimana langkahnya
        agar program tidak menjadi boros memory karena banyak
        menggunakan variable.

        nuhun

        Comment


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

          @Firman,

          sample code usages :

          '// jika object dari custom classes atau collection

          Code:
          If ( IsObject ( var_name ) ) then
               If ( not var_name is nothing ) then Set var_name = Nothing
          end if
          '// jika object connection / recordset ( database )

          Code:
          If ( Not obj is nothing ) then
               if ( obj.state = adstateopen ) then obj.close
               set obj = nothing
          end if
          '// jika array var

          Code:
          erase varr_array
          make it all being disposed with one function

          Code:
          public sub Dispose ( var_param as variant )
               '// do check var type dan gabungkan code2 di atas dalam 1 prosedur ini
          end sub
          ceritanya,,@firman

          tiap object classes hanya dimuat ke dalam memory bila dibuat instances dari classes tsb ( object ), common LOC untuk instance ini dengan menggunakan keyword NEW :

          Code:
          set objClass = NEW class
          bila instance berhasil di create, maka pada saat itu juga akan tersimpan ke dalam memory dan siap untuk digunakan oleh user ( programmer ).

          Nothing , gmana ceritanya kok bisa dipake sebagai indikator dalam
          Code:
          If ( not var_name is nothing ) then Set var_name = Nothing
          lalu dihapus juga dengan Set Nothing ???

          penjelasan singkat ( dari penjelasan yang jauh lebih rumit dan mendetail dari ini ) logical point of view :

          NEW keyword akan map memory sebesar class yang dibuat instance-nya ( relatif besar memory yang digunakan, ini tergantung dari design class itu sendiri dalam tahap logic coding nya ), NOTHING mengosongkan kembali memory tapi map dari object itu tetap tersimpan dalam structure process dari aplikasi. Hal ini memungkinkan untuk cepatnya aplikasi men-dimensikan kembali object dengan karakteristik yang sama ( naming - data type - type - etc ) dan identical , bila dicreate kembali dengan NEW ( bila di telusuri lebih dalam, hal ini juga berkaitan dengan adanya istilah CRASH dalam aplikasi bila coding si programmer itu JOROK !! )

          analogikan ini sebagai berikut :

          a = 0
          a = is nothing
          a = 1
          a = not nothing
          [ a ] tidak terbuang begitu saja walau sudah NOTHING, bila [ a ] sudah terbuang, maka tidak akan pernah bisa untuk di-identifikasi bagaimanapun juga, this is what i meant with MAP. Lalu kapan [ a ] itu terbuang ? semua akan terbuang dari memory bila process dari aplikasi itu drop / terminated

          Lalu, apa hubungan dengan APLIKASI BERJALAN LAMBAT ???

          semua variable yang dibuat akan dialokasikan ke dalam memory berdasar dari SUBSTANSI ( form - classes - module - etc ) yang SUSTAINED ( menampung ) dari semua variable itu ( weks ... bingung gk,,jangan bingung dulu ). Hal ini akan memungkinkan untuk semua var itu di RELEASE bila SUBSTANSI itu kita NOTHING kan, dan alokasi memory dapat digunakan oleh object yang lain ( another form, maybe ), hal ini akan membuat aplikasi dapat untuk berjalan dengan baik, tanpa terus menerus mengalokasikan memory baru untuk tiap object ( hanya diperlukan STRECTHING atau SHRINKED size dari allocated memories )

          analogi kembali :

          Form1
          '// punya general var sbb :
          dim a as integer , b as double, c as connection , r as recordset
          Form1 adalah root mapping
          semua [ a ] , [ b ] , [ c ], [ d ] akan di-release bila :
          Code:
          sub form1_unload ( .. )
              set form1 = nothing
          end sub
          Form1 sendiri adalah object dari class Form, itu memungkinkan untuk :

          Code:
          Dim Fm as form2
          set fm = new form2 ' // allocating
          load fm ' // executed a LOAD events
          set fm = nothing '// disposed
          lalu bagaimana dengan apa yg mereka bilang dengan GARBAGE COLLECTOR ?? in VB, bila sudah memasuki tahap object, maka perhatikanlah itu sendiri, hal ini membutuhkan disiplin coding dari programmer itu lagi.

          Hmm,,,dari se'uprit penjelasan ini, semoga berguna

          regard,

          Comment


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

            ada kasus baru nih ane mw cari semua file (wildcards) yg berukuran dibawah 4kb
            di sebuah folder yg huruf depannya diawal huruf T.

            apa ada caranya lewat vb6 menggunakan FileSystemObject

            mohon bantuannya
            Last edited by FirMan; 11-04-2012, 07:47.

            Comment


            • 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, 03:01.

              Comment


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

                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

                Comment


                • 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, 03:14.

                  Comment


                  • 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 ?

                    Comment


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

                      Comment


                      • 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

                        Comment

                        Working...
                        X