Penulis Topik: [bantuan] tolong avb  (Dibaca 2304 kali)

Offline FAKHRICKER

  • Pro500
  • ******
  • Tulisan: 714
  • Reputation: +1235/-0
  • Jenis kelamin: Pria
  • Dor
    • Lihat Profil
    • Iseng isengin orang disini tempatnya~
[bantuan] tolong avb
« pada: November 18, 2010, 01:16:19 PM »
hmm sebenarnya sya udah lama mengembangkan avb yg generasi 2 ( Standard edition )
Tapi slma 3 mggu sya mengalami kegagalan yang fatal
 ~x( ~x( ~x(
adakah diantara kalian yang bsa membantu AVB
permasalahannya adalah tinggal menambahkan fitur karantinanya
 Mhon bantuannya
 ^:)^ ^:)^ ^:)^
Dor dor dor

Offline Metamorphic

  • Pro500
  • ******
  • Tulisan: 951
  • Reputation: +35484/-1
  • Jenis kelamin: Pria
  • www.brigade-antivirus.com
    • Lihat Profil
    • BRIGADE Antivirus Indonesia
Re: [bantuan] tolong avb
« Jawab #1 pada: November 18, 2010, 03:27:48 PM »
slma 3 mggu sya mengalami kegagalan yang fatal

jgn pantang menyerah bro... kegagalan adalah kunci kesuksesan  <=) :-bd
ngomong2 pake engine apa nich?
BRIGADE ANTIVIRUS INDONESIA
... Dukung Semua Antivirus Indonesia !!!
Free Brigade Toolbar! http://www.brigade-antivirus.com/stat/a.php?id=15

Offline Metamorphic

  • Pro500
  • ******
  • Tulisan: 951
  • Reputation: +35484/-1
  • Jenis kelamin: Pria
  • www.brigade-antivirus.com
    • Lihat Profil
    • BRIGADE Antivirus Indonesia
Re: [bantuan] tolong avb
« Jawab #2 pada: November 18, 2010, 03:50:51 PM »
hmm sebenarnya sya udah lama mengembangkan avb yg generasi 2 ( Standard edition )
Tapi slma 3 mggu sya mengalami kegagalan yang fatal
 ~x( ~x( ~x(
adakah diantara kalian yang bsa membantu AVB
permasalahannya adalah tinggal menambahkan fitur karantinanya
 Mhon bantuannya
 ^:)^ ^:)^ ^:)^



Dulu ane Mempelajari pake code ini Bro..tinggal sesuaikan dengan engine yg udah jadi

Kode: [Pilih]
Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long
Const EM_UNDO = &HC7

Private Sub MDIForm_Load()
    Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 1000)
    Me.Top = GetSetting(App.Title, "Settings", "MainTop", 1000)
    Me.Width = GetSetting(App.Title, "Settings", "MainWidth", 6500)
    Me.Height = GetSetting(App.Title, "Settings", "MainHeight", 6500)
     
End Sub

Private Sub QuaForm_Unload(Cancel As Integer)
    If Me.WindowState <> vbMinimized Then
        SaveSetting App.Title, "Settings", "MainLeft", Me.Left
        SaveSetting App.Title, "Settings", "MainTop", Me.Top
        SaveSetting App.Title, "Settings", "MainWidth", Me.Width
        SaveSetting App.Title, "Settings", "MainHeight", Me.Height
    End If
    On Error Resume Next
    'Just in case if the database is awready closed
    dbDataBase.Close
End Sub

Private Sub mnuEditDelete_Click()
Dim I As Integer
   'Is table or query selected
   If frmDBControl.List1.ListIndex > -1 Then
      I = MsgBox("Are you sure wont to delete " & frmDBControl.List1.List(frmDBControl.List1.ListIndex), vbOKCancel + vbExclamation)
      If I = vbOK Then
         'If the selected is table or query
         If frmDBControl.List1.Tag = "Tables" Then
            dbDataBase.TableDefs.Delete (frmDBControl.List1.List(frmDBControl.List1.ListIndex))
            Call InputTablesToListBox(frmDBControl.List1)
         ElseIf frmDBControl.List1.Tag = "Queries" Then
            dbDataBase.QueryDefs.Delete (frmDBControl.List1.List(frmDBControl.List1.ListIndex))
            Call InputQueriesToListBox(frmDBControl.List1)
         End If
      End If
   Else
      MsgBox "You must select Table or Query", vbCritical, "Quarantine : Error"
   End If
End Sub

Private Sub mnuEditRename_Click()
Dim NewName As String
Dim Count As Integer
Dim OLDTableName As String
Dim OLDQueryName As String
Dim I As Integer
   ' On Error GoTo mnueditrenameerror
    With frmDBControl.List1
         If .ListIndex > -1 Then
            'The new table or query name
            NewName = InputBox("New Name : ", "QuarantineDB Rename " & .List(.ListIndex))
            If .Tag = "Tables" Then
                Count = dbDataBase.TableDefs.Count - 1
                'Find the table and rename it
                For I = 0 To Count
                    OLDTableName = dbDataBase.TableDefs(I).Name
                    If OLDTableName = .List(.ListIndex) Then
                       'Rename the table
                       dbDataBase.TableDefs(I).Name = NewName
                       'and update List1
                       .List(.ListIndex) = NewName
                    End If
                Next I
            ElseIf .Tag = "Queries" Then
                Count = dbDataBase.QueryDefs.Count - 1
                'Find the query and rename it
                For I = 0 To Count
                    OLDQueryName = dbDataBase.QueryDefs(I).Name
                    If OLDQueryName = .List(.ListIndex) Then
                       'Rename the query
                       dbDataBase.QueryDefs(I).Name = NewName
                       'and update List1
                       .List(.ListIndex) = NewName
                    End If
                Next I
            End If
         End If
    End With
End Sub

Private Sub mnuInsertQuery_Click()
   QueryName = InputBox("Input Query Name ", "Quarantine")
   If QueryName = "" Then
      MsgBox "Error : Query Name is Empty", vbCritical, "Quarantine : Error"
   Else
      frmCreateQuery.Caption = "Create Query : " & QueryName
      frmCreateQuery.Show
   End If
End Sub

Private Sub mnuInsertTable_Click()
   frmCreateTable.Show
End Sub

Private Sub tbToolBar_ButtonClick(ByVal Button As MSComCtlLib.Button)
    On Error Resume Next
    Select Case Button.Key
        Case "New"
            mnuFileNew_Click
        Case "Open"
            mnuFileOpen_Click
        Case "Cut"
            mnuEditCut_Click
        Case "Copy"
            mnuEditCopy_Click
        Case "Paste"
            mnuEditPaste_Click
    End Select
End Sub

Private Sub mnuHelpAbout_Click()
    MsgBox "Version " & App.Major & "." & App.Minor & "." & App.Revision
End Sub

Private Sub mnuWindowCascade_Click()
    Me.Arrange vbCascade
End Sub

Private Sub mnuWindowArrangeIcons_Click()
    Me.Arrange vbArrangeIcons
End Sub

Private Sub mnuWindowTileVertical_Click()
    Me.Arrange vbTileVertical
End Sub

Private Sub mnuWindowTileHorizontal_Click()
    Me.Arrange vbTileHorizontal
End Sub

Private Sub mnuWindowNewWindow_Click()
    '----
End Sub

Private Sub mnuViewRefresh_Click()
   On Error Resume Next
   ActiveForm.Adodc1.Refresh
End Sub

Private Sub mnuViewStatusBar_Click()
    mnuViewStatusBar.Checked = Not mnuViewStatusBar.Checked
    sbStatusBar.Visible = mnuViewStatusBar.Checked
End Sub

Private Sub mnuViewToolbar_Click()
    mnuViewToolbar.Checked = Not mnuViewToolbar.Checked
    tbToolBar.Visible = mnuViewToolbar.Checked
End Sub

Private Sub mnuEditPaste_Click()
    On Error Resume Next
    ActiveForm.grdDataGrid.SelText = Clipboard.GetText
End Sub

Private Sub mnuEditCopy_Click()
    On Error Resume Next
    Clipboard.SetText ActiveForm.grdDataGrid.SelText
End Sub

Private Sub mnuEditCut_Click()
    On Error Resume Next
    Clipboard.SetText ActiveForm.grdDataGrid.SelText
    ActiveForm.grdDataGrid.SelText = vbNullString
   
End Sub

Private Sub mnuFileExit_Click()
    'unload the form
    Unload Me
End Sub

Private Sub mnuFileClose_Click()
   On Error Resume Next
   dbDataBase.Close
   mnuFileClose.Enabled = False
End Sub

Private Sub mnuFileOpen_Click()
Dim FileName As String
    On Error GoTo mnuFileOpenError:
    With dlgCommonDialog
        .DialogTitle = "Open"
        .CancelError = False
        .Filter = "MS Access DataBases (*.mdb)|*.mdb"
        .ShowOpen
        If Len(.FileName) = 0 Then
            Exit Sub
        End If
        FileName = .FileName
    End With
   
    frmShowRecordset.Adodc1.ConnectionString = "PROVIDER=Microsoft.Jet.OLEDB.3.51;Data Source=" & FileName & ";"
       
    Set dbWorkSpace = DBEngine.Workspaces(0)
    Set dbDataBase = dbWorkSpace.OpenDatabase(FileName)
    'Now you can Create new table
    mnuInsertTable.Enabled = True
    '------------------ new Query
    mnuInsertQuery.Enabled = True
    '----------- delete tables or queries
    mnuEditDelete.Enabled = True
    '----------- rename tables or queries
    mnuEditRename.Enabled = True
    '----------- close the database
    mnuFileClose.Enabled = True
    'Input the tables from the Database in frmDBControl.List1
    Call InputTablesToListBox(frmDBControl.List1)
                     
    frmDBControl.Caption = "Database : " & dlgCommonDialog.FileTitle
    frmDBControl.Show
   
    Exit Sub

mnuFileOpenError:
MsgBox Err.Description, vbCritical, "Quarantine : Error Num." & Err.Number
End Sub

Private Sub mnuFileNew_Click()
Dim NewDBName As String
   On Error Resume Next
   dbWorkSpace.Close
   On Error GoTo mnuFileNewError
   'NewDBName = InputBox("DataBase Name : ", "Quarantine Create New DataBase")
   With dlgCommonDialog
        .DialogTitle = "Create Database"
        .CancelError = False
        .Filter = "MS Access DataBases (*.mdb)|*.mdb"
        .ShowSave
        If Len(.FileName) = 0 Then
           Exit Sub
        End If
        NewDBName = dlgCommonDialog.FileName
        Set dbWorkSpace = Engine.Workspaces(0)
        Set dbDataBase = dbWorkSpace.CreateDatabase(NewDBName, dbLangGeneral)
       
        Call InputTablesToListBox(frmDBControl.List1)
                     
        'Now you can Create new table
        mnuInsertTable.Enabled = True
        '------------------ new Query
        mnuInsertQuery.Enabled = True
        '----------- delete tables or queries
         mnuEditDelete.Enabled = True
        '----------- rename tables or queries
        mnuEditRename.Enabled = True
        '----------- close the database
        mnuFileClose.Enabled = True
       
        frmDBControl.Caption = "Database : " & dlgCommonDialog.FileTitle
        frmDBControl.Show
    End With
    Exit Sub
mnuFileNewError:
MsgBox Err.Description, vbCritical, "Quarantine Error Num." & Err.Number
End Sub

dibawah ini Modul aslinya Quarantine menggunakan MDB

Kode: [Pilih]
Public fMainForm As frmMain
Public adoRecordset As ADODB.Recordset
Public adoConnection As ADODB.Connection
Public dbWorkSpace As Workspace
Public dbDataBase As Database
Public dbTableDef As TableDef
Public dbFieldNew As Field
Public dbTable As Recordset
Public dbQueryDef As QueryDef
Public dbQuery As Recordset

Public InputTheNewTable As Boolean 'dali nowatya tablica da se sloji v listbox
Public QueryName As String

Public Type FieldProperties
       FieldName As String
       Type As DatabaseTypeEnum
       Size As Byte
End Type

Sub Main()
    Dim fLogin As New frmLogin
    fLogin.Show vbModal
    If Not fLogin.OK Then
        'Login Failed so exit app
        End
    End If
    Unload fLogin


    Set fMainForm = New frmMain
    fMainForm.Show
End Sub

Public Sub InputTablesToListBox(List1 As ListBox)
'raboti s DAO
Dim TablesCount As Long
Dim TableName As String
Dim I As Integer
    On Error GoTo InputTablesToListBoxError
    List1.Clear
    'broqt na kolonite
    TablesCount = dbDataBase.TableDefs.Count
    'pupvite 6 ne sa za pokazvane (nekvi sturotii na access)
    For I = 0 To TablesCount - 1
        Set dbTableDef = dbDataBase.TableDefs(I)
        TableName = dbTableDef.Name
        'tova sa tablici na Access koito ne trqbva da se pipat
        If TableName <> "MSysAccessObjects" And TableName <> "MSysACEs" And TableName <> "MSysObjects" And TableName <> "MSysQueries" And TableName <> "MSysRelationships" Then
           List1.AddItem TableName
        End If
    Next I
    List1.Tag = "Tables"
    Exit Sub
InputTablesToListBoxError:
MsgBox Err.Description, vbCritical, "QuarantineDB : Error Num." & Err.Number
End Sub

Public Sub InputQueriesToListBox(List1 As ListBox)
'raboti s DAO
Dim QueriesCount As Long
Dim I As Integer
    On Error GoTo InputQueriesToListBoxError
    List1.Clear
    'broqt na kolonite
    QueriesCount = dbDataBase.QueryDefs.Count - 1
    'pupvite 6 ne sa za pokazvane (nekvi sturotii na access)
    For I = 0 To QueriesCount
        Set dbQueryDef = dbDataBase.QueryDefs(I)
        List1.AddItem dbQueryDef.Name
    Next I
    List1.Tag = "Queries"
    Exit Sub

InputQueriesToListBoxError:
MsgBox Err.Description, vbCritical, "QuarantineDB : Error Num." & Err.Number
End Sub

Public Function FindTypeConstant(strType As String) As Byte
    Select Case strType
           Case "Boolean": FindTypeConstant = 1
           Case "Byte": FindTypeConstant = 2
           Case "Integer": FindTypeConstant = 3
           Case "Long": FindTypeConstant = 4
           Case "Currency": FindTypeConstant = 5
           Case "Single": FindTypeConstant = 6
           Case "Double": FindTypeConstant = 7
           Case "Date/Time": FindTypeConstant = 8
           Case "Text": FindTypeConstant = 10
           Case "Binary": FindTypeConstant = 9
           Case "Memo": FindTypeConstant = 12
     End Select
End Function

Public Sub InputTablesToComboBox(ComboBox1 As ComboBox)
'raboti s DAO
Dim TablesCount As Long
Dim TableName As String
Dim I As Integer
    On Error GoTo InputTablesToComboBoxError
    ComboBox1.Clear
    'broqt na kolonite
    TablesCount = dbDataBase.TableDefs.Count
    'pupvite 6 ne sa za pokazvane (nekvi sturotii na access)
    For I = 0 To TablesCount - 1
        Set dbTableDef = dbDataBase.TableDefs(I)
        TableName = dbTableDef.Name
        'tova sa tablici na Access koito ne trqbva da se pipat
        If TableName <> "MSysAccessObjects" And TableName <> "MSysACEs" And TableName <> "MSysObjects" And TableName <> "MSysQueries" And TableName <> "MSysRelationships" Then
           ComboBox1.AddItem TableName
        End If
    Next I
    Exit Sub
InputTablesToComboBoxError:
MsgBox Err.Description, vbCritical, "QuarantineDB : Error Num." & Err.Number
End Sub


monggo tinggal di modifikasi  :-bd
BRIGADE ANTIVIRUS INDONESIA
... Dukung Semua Antivirus Indonesia !!!
Free Brigade Toolbar! http://www.brigade-antivirus.com/stat/a.php?id=15

Offline c0d3HitLER

  • Pro500
  • ******
  • Tulisan: 676
  • Reputation: +50398/-0
  • Jenis kelamin: Pria
  • KOPASUS IT
    • Lihat Profil
    • KOPASUS IT
Re: [bantuan] tolong avb
« Jawab #3 pada: November 18, 2010, 05:34:48 PM »
hmm sebenarnya sya udah lama mengembangkan avb yg generasi 2 ( Standard edition )
Tapi slma 3 mggu sya mengalami kegagalan yang fatal
 ~x( ~x( ~x(
adakah diantara kalian yang bsa membantu AVB
permasalahannya adalah tinggal menambahkan fitur karantinanya
 Mhon bantuannya
 ^:)^ ^:)^ ^:)^


Dulu ane Mempelajari pake code ini Bro..tinggal sesuaikan dengan engine yg udah jadi

Kode: [Pilih]
Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long
Const EM_UNDO = &HC7

Private Sub MDIForm_Load()
    Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 1000)
    Me.Top = GetSetting(App.Title, "Settings", "MainTop", 1000)
    Me.Width = GetSetting(App.Title, "Settings", "MainWidth", 6500)
    Me.Height = GetSetting(App.Title, "Settings", "MainHeight", 6500)
    
End Sub

Private Sub QuaForm_Unload(Cancel As Integer)
    If Me.WindowState <> vbMinimized Then
        SaveSetting App.Title, "Settings", "MainLeft", Me.Left
        SaveSetting App.Title, "Settings", "MainTop", Me.Top
        SaveSetting App.Title, "Settings", "MainWidth", Me.Width
        SaveSetting App.Title, "Settings", "MainHeight", Me.Height
    End If
    On Error Resume Next
    'Just in case if the database is awready closed
    dbDataBase.Close
End Sub

Private Sub mnuEditDelete_Click()
Dim I As Integer
   'Is table or query selected
   If frmDBControl.List1.ListIndex > -1 Then
      I = MsgBox("Are you sure wont to delete " & frmDBControl.List1.List(frmDBControl.List1.ListIndex), vbOKCancel + vbExclamation)
      If I = vbOK Then
         'If the selected is table or query
         If frmDBControl.List1.Tag = "Tables" Then
            dbDataBase.TableDefs.Delete (frmDBControl.List1.List(frmDBControl.List1.ListIndex))
            Call InputTablesToListBox(frmDBControl.List1)
         ElseIf frmDBControl.List1.Tag = "Queries" Then
            dbDataBase.QueryDefs.Delete (frmDBControl.List1.List(frmDBControl.List1.ListIndex))
            Call InputQueriesToListBox(frmDBControl.List1)
         End If
      End If
   Else
      MsgBox "You must select Table or Query", vbCritical, "Quarantine : Error"
   End If
End Sub

Private Sub mnuEditRename_Click()
Dim NewName As String
Dim Count As Integer
Dim OLDTableName As String
Dim OLDQueryName As String
Dim I As Integer
   ' On Error GoTo mnueditrenameerror
    With frmDBControl.List1
         If .ListIndex > -1 Then
            'The new table or query name
            NewName = InputBox("New Name : ", "QuarantineDB Rename " & .List(.ListIndex))
            If .Tag = "Tables" Then
                Count = dbDataBase.TableDefs.Count - 1
                'Find the table and rename it
                For I = 0 To Count
                    OLDTableName = dbDataBase.TableDefs(I).Name
                    If OLDTableName = .List(.ListIndex) Then
                       'Rename the table
                       dbDataBase.TableDefs(I).Name = NewName
                       'and update List1
                       .List(.ListIndex) = NewName
                    End If
                Next I
            ElseIf .Tag = "Queries" Then
                Count = dbDataBase.QueryDefs.Count - 1
                'Find the query and rename it
                For I = 0 To Count
                    OLDQueryName = dbDataBase.QueryDefs(I).Name
                    If OLDQueryName = .List(.ListIndex) Then
                       'Rename the query
                       dbDataBase.QueryDefs(I).Name = NewName
                       'and update List1
                       .List(.ListIndex) = NewName
                    End If
                Next I
            End If
         End If
    End With
End Sub

Private Sub mnuInsertQuery_Click()
   QueryName = InputBox("Input Query Name ", "Quarantine")
   If QueryName = "" Then
      MsgBox "Error : Query Name is Empty", vbCritical, "Quarantine : Error"
   Else
      frmCreateQuery.Caption = "Create Query : " & QueryName
      frmCreateQuery.Show
   End If
End Sub

Private Sub mnuInsertTable_Click()
   frmCreateTable.Show
End Sub

Private Sub tbToolBar_ButtonClick(ByVal Button As MSComCtlLib.Button)
    On Error Resume Next
    Select Case Button.Key
        Case "New"
            mnuFileNew_Click
        Case "Open"
            mnuFileOpen_Click
        Case "Cut"
            mnuEditCut_Click
        Case "Copy"
            mnuEditCopy_Click
        Case "Paste"
            mnuEditPaste_Click
    End Select
End Sub

Private Sub mnuHelpAbout_Click()
    MsgBox "Version " & App.Major & "." & App.Minor & "." & App.Revision
End Sub

Private Sub mnuWindowCascade_Click()
    Me.Arrange vbCascade
End Sub

Private Sub mnuWindowArrangeIcons_Click()
    Me.Arrange vbArrangeIcons
End Sub

Private Sub mnuWindowTileVertical_Click()
    Me.Arrange vbTileVertical
End Sub

Private Sub mnuWindowTileHorizontal_Click()
    Me.Arrange vbTileHorizontal
End Sub

Private Sub mnuWindowNewWindow_Click()
    '----
End Sub

Private Sub mnuViewRefresh_Click()
   On Error Resume Next
   ActiveForm.Adodc1.Refresh
End Sub

Private Sub mnuViewStatusBar_Click()
    mnuViewStatusBar.Checked = Not mnuViewStatusBar.Checked
    sbStatusBar.Visible = mnuViewStatusBar.Checked
End Sub

Private Sub mnuViewToolbar_Click()
    mnuViewToolbar.Checked = Not mnuViewToolbar.Checked
    tbToolBar.Visible = mnuViewToolbar.Checked
End Sub

Private Sub mnuEditPaste_Click()
    On Error Resume Next
    ActiveForm.grdDataGrid.SelText = Clipboard.GetText
End Sub

Private Sub mnuEditCopy_Click()
    On Error Resume Next
    Clipboard.SetText ActiveForm.grdDataGrid.SelText
End Sub

Private Sub mnuEditCut_Click()
    On Error Resume Next
    Clipboard.SetText ActiveForm.grdDataGrid.SelText
    ActiveForm.grdDataGrid.SelText = vbNullString
    
End Sub

Private Sub mnuFileExit_Click()
    'unload the form
    Unload Me
End Sub

Private Sub mnuFileClose_Click()
   On Error Resume Next
   dbDataBase.Close
   mnuFileClose.Enabled = False
End Sub

Private Sub mnuFileOpen_Click()
Dim FileName As String
    On Error GoTo mnuFileOpenError:
    With dlgCommonDialog
        .DialogTitle = "Open"
        .CancelError = False
        .Filter = "MS Access DataBases (*.mdb)|*.mdb"
        .ShowOpen
        If Len(.FileName) = 0 Then
            Exit Sub
        End If
        FileName = .FileName
    End With
  
    frmShowRecordset.Adodc1.ConnectionString = "PROVIDER=Microsoft.Jet.OLEDB.3.51;Data Source=" & FileName & ";"
      
    Set dbWorkSpace = DBEngine.Workspaces(0)
    Set dbDataBase = dbWorkSpace.OpenDatabase(FileName)
    'Now you can Create new table
    mnuInsertTable.Enabled = True
    '------------------ new Query
    mnuInsertQuery.Enabled = True
    '----------- delete tables or queries
    mnuEditDelete.Enabled = True
    '----------- rename tables or queries
    mnuEditRename.Enabled = True
    '----------- close the database
    mnuFileClose.Enabled = True
    'Input the tables from the Database in frmDBControl.List1
    Call InputTablesToListBox(frmDBControl.List1)
                    
    frmDBControl.Caption = "Database : " & dlgCommonDialog.FileTitle
    frmDBControl.Show
    
    Exit Sub

mnuFileOpenError:
MsgBox Err.Description, vbCritical, "Quarantine : Error Num." & Err.Number
End Sub

Private Sub mnuFileNew_Click()
Dim NewDBName As String
   On Error Resume Next
   dbWorkSpace.Close
   On Error GoTo mnuFileNewError
   'NewDBName = InputBox("DataBase Name : ", "Quarantine Create New DataBase")
   With dlgCommonDialog
        .DialogTitle = "Create Database"
        .CancelError = False
        .Filter = "MS Access DataBases (*.mdb)|*.mdb"
        .ShowSave
        If Len(.FileName) = 0 Then
           Exit Sub
        End If
        NewDBName = dlgCommonDialog.FileName
        Set dbWorkSpace = Engine.Workspaces(0)
        Set dbDataBase = dbWorkSpace.CreateDatabase(NewDBName, dbLangGeneral)
        
        Call InputTablesToListBox(frmDBControl.List1)
                    
        'Now you can Create new table
        mnuInsertTable.Enabled = True
        '------------------ new Query
        mnuInsertQuery.Enabled = True
        '----------- delete tables or queries
         mnuEditDelete.Enabled = True
        '----------- rename tables or queries
        mnuEditRename.Enabled = True
        '----------- close the database
        mnuFileClose.Enabled = True
        
        frmDBControl.Caption = "Database : " & dlgCommonDialog.FileTitle
        frmDBControl.Show
    End With
    Exit Sub
mnuFileNewError:
MsgBox Err.Description, vbCritical, "Quarantine Error Num." & Err.Number
End Sub

dibawah ini Modul aslinya Quarantine menggunakan MDB

Kode: [Pilih]
Public fMainForm As frmMain
Public adoRecordset As ADODB.Recordset
Public adoConnection As ADODB.Connection
Public dbWorkSpace As Workspace
Public dbDataBase As Database
Public dbTableDef As TableDef
Public dbFieldNew As Field
Public dbTable As Recordset
Public dbQueryDef As QueryDef
Public dbQuery As Recordset

Public InputTheNewTable As Boolean 'dali nowatya tablica da se sloji v listbox
Public QueryName As String

Public Type FieldProperties
       FieldName As String
       Type As DatabaseTypeEnum
       Size As Byte
End Type

Sub Main()
    Dim fLogin As New frmLogin
    fLogin.Show vbModal
    If Not fLogin.OK Then
        'Login Failed so exit app
        End
    End If
    Unload fLogin


    Set fMainForm = New frmMain
    fMainForm.Show
End Sub

Public Sub InputTablesToListBox(List1 As ListBox)
'raboti s DAO
Dim TablesCount As Long
Dim TableName As String
Dim I As Integer
    On Error GoTo InputTablesToListBoxError
    List1.Clear
    'broqt na kolonite
    TablesCount = dbDataBase.TableDefs.Count
    'pupvite 6 ne sa za pokazvane (nekvi sturotii na access)
    For I = 0 To TablesCount - 1
        Set dbTableDef = dbDataBase.TableDefs(I)
        TableName = dbTableDef.Name
        'tova sa tablici na Access koito ne trqbva da se pipat
        If TableName <> "MSysAccessObjects" And TableName <> "MSysACEs" And TableName <> "MSysObjects" And TableName <> "MSysQueries" And TableName <> "MSysRelationships" Then
           List1.AddItem TableName
        End If
    Next I
    List1.Tag = "Tables"
    Exit Sub
InputTablesToListBoxError:
MsgBox Err.Description, vbCritical, "QuarantineDB : Error Num." & Err.Number
End Sub

Public Sub InputQueriesToListBox(List1 As ListBox)
'raboti s DAO
Dim QueriesCount As Long
Dim I As Integer
    On Error GoTo InputQueriesToListBoxError
    List1.Clear
    'broqt na kolonite
    QueriesCount = dbDataBase.QueryDefs.Count - 1
    'pupvite 6 ne sa za pokazvane (nekvi sturotii na access)
    For I = 0 To QueriesCount
        Set dbQueryDef = dbDataBase.QueryDefs(I)
        List1.AddItem dbQueryDef.Name
    Next I
    List1.Tag = "Queries"
    Exit Sub

InputQueriesToListBoxError:
MsgBox Err.Description, vbCritical, "QuarantineDB : Error Num." & Err.Number
End Sub

Public Function FindTypeConstant(strType As String) As Byte
    Select Case strType
           Case "Boolean": FindTypeConstant = 1
           Case "Byte": FindTypeConstant = 2
           Case "Integer": FindTypeConstant = 3
           Case "Long": FindTypeConstant = 4
           Case "Currency": FindTypeConstant = 5
           Case "Single": FindTypeConstant = 6
           Case "Double": FindTypeConstant = 7
           Case "Date/Time": FindTypeConstant = 8
           Case "Text": FindTypeConstant = 10
           Case "Binary": FindTypeConstant = 9
           Case "Memo": FindTypeConstant = 12
     End Select
End Function

Public Sub InputTablesToComboBox(ComboBox1 As ComboBox)
'raboti s DAO
Dim TablesCount As Long
Dim TableName As String
Dim I As Integer
    On Error GoTo InputTablesToComboBoxError
    ComboBox1.Clear
    'broqt na kolonite
    TablesCount = dbDataBase.TableDefs.Count
    'pupvite 6 ne sa za pokazvane (nekvi sturotii na access)
    For I = 0 To TablesCount - 1
        Set dbTableDef = dbDataBase.TableDefs(I)
        TableName = dbTableDef.Name
        'tova sa tablici na Access koito ne trqbva da se pipat
        If TableName <> "MSysAccessObjects" And TableName <> "MSysACEs" And TableName <> "MSysObjects" And TableName <> "MSysQueries" And TableName <> "MSysRelationships" Then
           ComboBox1.AddItem TableName
        End If
    Next I
    Exit Sub
InputTablesToComboBoxError:
MsgBox Err.Description, vbCritical, "QuarantineDB : Error Num." & Err.Number
End Sub


monggo tinggal di modifikasi  :-bd
Bisa ksi SC-nya gag yg lengkap dgn formnya? Soalnya kami dari AVB lagi pusing nih
Boleh ya? :-bd
Berbahasa yang baik dan mempererat persaudaraan

Offline thirteen™

  • Pro500
  • ******
  • Tulisan: 1.155
  • Reputation: +65535/-335
  • Jenis kelamin: Pria
  • Admin of ForCamp
    • Lihat Profil
    • My Website
Re: [bantuan] tolong avb
« Jawab #4 pada: November 18, 2010, 05:39:28 PM »
btw,, AVB gabungan dari programmer2 hebat kan ?
gak bermaksut menyinggung gan ,, kenapa baru mau update sekarang ?
█║▌│█│║▌║││█║▌│║▌
©2011 All Right Reserved
by Krisna Soekamti™

Offline c0d3HitLER

  • Pro500
  • ******
  • Tulisan: 676
  • Reputation: +50398/-0
  • Jenis kelamin: Pria
  • KOPASUS IT
    • Lihat Profil
    • KOPASUS IT
Re: [bantuan] tolong avb
« Jawab #5 pada: November 18, 2010, 05:45:31 PM »
btw,, AVB gabungan dari programmer2 hebat kan ?
gak bermaksut menyinggung gan ,, kenapa baru mau update sekarang ?
aduh gmn ya gan?
pd jarang nongol sih dan yang paling bersemangat ya mas FAKHRICKER :-bd
Berbahasa yang baik dan mempererat persaudaraan

Offline thirteen™

  • Pro500
  • ******
  • Tulisan: 1.155
  • Reputation: +65535/-335
  • Jenis kelamin: Pria
  • Admin of ForCamp
    • Lihat Profil
    • My Website
Re: [bantuan] tolong avb
« Jawab #6 pada: November 18, 2010, 05:47:36 PM »
btw,, AVB gabungan dari programmer2 hebat kan ?
gak bermaksut menyinggung gan ,, kenapa baru mau update sekarang ?
aduh gmn ya gan?
pd jarang nongol sih dan yang paling bersemangat ya mas FAKHRICKER :-bd

udah dicoba belum code dari Blitz ?
█║▌│█│║▌║││█║▌│║▌
©2011 All Right Reserved
by Krisna Soekamti™

Offline FAKHRICKER

  • Pro500
  • ******
  • Tulisan: 714
  • Reputation: +1235/-0
  • Jenis kelamin: Pria
  • Dor
    • Lihat Profil
    • Iseng isengin orang disini tempatnya~
Re: [bantuan] tolong avb
« Jawab #7 pada: November 21, 2010, 06:15:01 PM »
hmm sebenarnya sya udah lama mengembangkan avb yg generasi 2 ( Standard edition )
Tapi slma 3 mggu sya mengalami kegagalan yang fatal
 ~x( ~x( ~x(
adakah diantara kalian yang bsa membantu AVB
permasalahannya adalah tinggal menambahkan fitur karantinanya
 Mhon bantuannya
 ^:)^ ^:)^ ^:)^



Dulu ane Mempelajari pake code ini Bro..tinggal sesuaikan dengan engine yg udah jadi

Kode: [Pilih]
Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long
Const EM_UNDO = &HC7

Private Sub MDIForm_Load()
    Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 1000)
    Me.Top = GetSetting(App.Title, "Settings", "MainTop", 1000)
    Me.Width = GetSetting(App.Title, "Settings", "MainWidth", 6500)
    Me.Height = GetSetting(App.Title, "Settings", "MainHeight", 6500)
     
End Sub

Private Sub QuaForm_Unload(Cancel As Integer)
    If Me.WindowState <> vbMinimized Then
        SaveSetting App.Title, "Settings", "MainLeft", Me.Left
        SaveSetting App.Title, "Settings", "MainTop", Me.Top
        SaveSetting App.Title, "Settings", "MainWidth", Me.Width
        SaveSetting App.Title, "Settings", "MainHeight", Me.Height
    End If
    On Error Resume Next
    'Just in case if the database is awready closed
    dbDataBase.Close
End Sub

Private Sub mnuEditDelete_Click()
Dim I As Integer
   'Is table or query selected
   If frmDBControl.List1.ListIndex > -1 Then
      I = MsgBox("Are you sure wont to delete " & frmDBControl.List1.List(frmDBControl.List1.ListIndex), vbOKCancel + vbExclamation)
      If I = vbOK Then
         'If the selected is table or query
         If frmDBControl.List1.Tag = "Tables" Then
            dbDataBase.TableDefs.Delete (frmDBControl.List1.List(frmDBControl.List1.ListIndex))
            Call InputTablesToListBox(frmDBControl.List1)
         ElseIf frmDBControl.List1.Tag = "Queries" Then
            dbDataBase.QueryDefs.Delete (frmDBControl.List1.List(frmDBControl.List1.ListIndex))
            Call InputQueriesToListBox(frmDBControl.List1)
         End If
      End If
   Else
      MsgBox "You must select Table or Query", vbCritical, "Quarantine : Error"
   End If
End Sub

Private Sub mnuEditRename_Click()
Dim NewName As String
Dim Count As Integer
Dim OLDTableName As String
Dim OLDQueryName As String
Dim I As Integer
   ' On Error GoTo mnueditrenameerror
    With frmDBControl.List1
         If .ListIndex > -1 Then
            'The new table or query name
            NewName = InputBox("New Name : ", "QuarantineDB Rename " & .List(.ListIndex))
            If .Tag = "Tables" Then
                Count = dbDataBase.TableDefs.Count - 1
                'Find the table and rename it
                For I = 0 To Count
                    OLDTableName = dbDataBase.TableDefs(I).Name
                    If OLDTableName = .List(.ListIndex) Then
                       'Rename the table
                       dbDataBase.TableDefs(I).Name = NewName
                       'and update List1
                       .List(.ListIndex) = NewName
                    End If
                Next I
            ElseIf .Tag = "Queries" Then
                Count = dbDataBase.QueryDefs.Count - 1
                'Find the query and rename it
                For I = 0 To Count
                    OLDQueryName = dbDataBase.QueryDefs(I).Name
                    If OLDQueryName = .List(.ListIndex) Then
                       'Rename the query
                       dbDataBase.QueryDefs(I).Name = NewName
                       'and update List1
                       .List(.ListIndex) = NewName
                    End If
                Next I
            End If
         End If
    End With
End Sub

Private Sub mnuInsertQuery_Click()
   QueryName = InputBox("Input Query Name ", "Quarantine")
   If QueryName = "" Then
      MsgBox "Error : Query Name is Empty", vbCritical, "Quarantine : Error"
   Else
      frmCreateQuery.Caption = "Create Query : " & QueryName
      frmCreateQuery.Show
   End If
End Sub

Private Sub mnuInsertTable_Click()
   frmCreateTable.Show
End Sub

Private Sub tbToolBar_ButtonClick(ByVal Button As MSComCtlLib.Button)
    On Error Resume Next
    Select Case Button.Key
        Case "New"
            mnuFileNew_Click
        Case "Open"
            mnuFileOpen_Click
        Case "Cut"
            mnuEditCut_Click
        Case "Copy"
            mnuEditCopy_Click
        Case "Paste"
            mnuEditPaste_Click
    End Select
End Sub

Private Sub mnuHelpAbout_Click()
    MsgBox "Version " & App.Major & "." & App.Minor & "." & App.Revision
End Sub

Private Sub mnuWindowCascade_Click()
    Me.Arrange vbCascade
End Sub

Private Sub mnuWindowArrangeIcons_Click()
    Me.Arrange vbArrangeIcons
End Sub

Private Sub mnuWindowTileVertical_Click()
    Me.Arrange vbTileVertical
End Sub

Private Sub mnuWindowTileHorizontal_Click()
    Me.Arrange vbTileHorizontal
End Sub

Private Sub mnuWindowNewWindow_Click()
    '----
End Sub

Private Sub mnuViewRefresh_Click()
   On Error Resume Next
   ActiveForm.Adodc1.Refresh
End Sub

Private Sub mnuViewStatusBar_Click()
    mnuViewStatusBar.Checked = Not mnuViewStatusBar.Checked
    sbStatusBar.Visible = mnuViewStatusBar.Checked
End Sub

Private Sub mnuViewToolbar_Click()
    mnuViewToolbar.Checked = Not mnuViewToolbar.Checked
    tbToolBar.Visible = mnuViewToolbar.Checked
End Sub

Private Sub mnuEditPaste_Click()
    On Error Resume Next
    ActiveForm.grdDataGrid.SelText = Clipboard.GetText
End Sub

Private Sub mnuEditCopy_Click()
    On Error Resume Next
    Clipboard.SetText ActiveForm.grdDataGrid.SelText
End Sub

Private Sub mnuEditCut_Click()
    On Error Resume Next
    Clipboard.SetText ActiveForm.grdDataGrid.SelText
    ActiveForm.grdDataGrid.SelText = vbNullString
   
End Sub

Private Sub mnuFileExit_Click()
    'unload the form
    Unload Me
End Sub

Private Sub mnuFileClose_Click()
   On Error Resume Next
   dbDataBase.Close
   mnuFileClose.Enabled = False
End Sub

Private Sub mnuFileOpen_Click()
Dim FileName As String
    On Error GoTo mnuFileOpenError:
    With dlgCommonDialog
        .DialogTitle = "Open"
        .CancelError = False
        .Filter = "MS Access DataBases (*.mdb)|*.mdb"
        .ShowOpen
        If Len(.FileName) = 0 Then
            Exit Sub
        End If
        FileName = .FileName
    End With
   
    frmShowRecordset.Adodc1.ConnectionString = "PROVIDER=Microsoft.Jet.OLEDB.3.51;Data Source=" & FileName & ";"
       
    Set dbWorkSpace = DBEngine.Workspaces(0)
    Set dbDataBase = dbWorkSpace.OpenDatabase(FileName)
    'Now you can Create new table
    mnuInsertTable.Enabled = True
    '------------------ new Query
    mnuInsertQuery.Enabled = True
    '----------- delete tables or queries
    mnuEditDelete.Enabled = True
    '----------- rename tables or queries
    mnuEditRename.Enabled = True
    '----------- close the database
    mnuFileClose.Enabled = True
    'Input the tables from the Database in frmDBControl.List1
    Call InputTablesToListBox(frmDBControl.List1)
                     
    frmDBControl.Caption = "Database : " & dlgCommonDialog.FileTitle
    frmDBControl.Show
   
    Exit Sub

mnuFileOpenError:
MsgBox Err.Description, vbCritical, "Quarantine : Error Num." & Err.Number
End Sub

Private Sub mnuFileNew_Click()
Dim NewDBName As String
   On Error Resume Next
   dbWorkSpace.Close
   On Error GoTo mnuFileNewError
   'NewDBName = InputBox("DataBase Name : ", "Quarantine Create New DataBase")
   With dlgCommonDialog
        .DialogTitle = "Create Database"
        .CancelError = False
        .Filter = "MS Access DataBases (*.mdb)|*.mdb"
        .ShowSave
        If Len(.FileName) = 0 Then
           Exit Sub
        End If
        NewDBName = dlgCommonDialog.FileName
        Set dbWorkSpace = Engine.Workspaces(0)
        Set dbDataBase = dbWorkSpace.CreateDatabase(NewDBName, dbLangGeneral)
       
        Call InputTablesToListBox(frmDBControl.List1)
                     
        'Now you can Create new table
        mnuInsertTable.Enabled = True
        '------------------ new Query
        mnuInsertQuery.Enabled = True
        '----------- delete tables or queries
         mnuEditDelete.Enabled = True
        '----------- rename tables or queries
        mnuEditRename.Enabled = True
        '----------- close the database
        mnuFileClose.Enabled = True
       
        frmDBControl.Caption = "Database : " & dlgCommonDialog.FileTitle
        frmDBControl.Show
    End With
    Exit Sub
mnuFileNewError:
MsgBox Err.Description, vbCritical, "Quarantine Error Num." & Err.Number
End Sub

dibawah ini Modul aslinya Quarantine menggunakan MDB

Kode: [Pilih]
Public fMainForm As frmMain
Public adoRecordset As ADODB.Recordset
Public adoConnection As ADODB.Connection
Public dbWorkSpace As Workspace
Public dbDataBase As Database
Public dbTableDef As TableDef
Public dbFieldNew As Field
Public dbTable As Recordset
Public dbQueryDef As QueryDef
Public dbQuery As Recordset

Public InputTheNewTable As Boolean 'dali nowatya tablica da se sloji v listbox
Public QueryName As String

Public Type FieldProperties
       FieldName As String
       Type As DatabaseTypeEnum
       Size As Byte
End Type

Sub Main()
    Dim fLogin As New frmLogin
    fLogin.Show vbModal
    If Not fLogin.OK Then
        'Login Failed so exit app
        End
    End If
    Unload fLogin


    Set fMainForm = New frmMain
    fMainForm.Show
End Sub

Public Sub InputTablesToListBox(List1 As ListBox)
'raboti s DAO
Dim TablesCount As Long
Dim TableName As String
Dim I As Integer
    On Error GoTo InputTablesToListBoxError
    List1.Clear
    'broqt na kolonite
    TablesCount = dbDataBase.TableDefs.Count
    'pupvite 6 ne sa za pokazvane (nekvi sturotii na access)
    For I = 0 To TablesCount - 1
        Set dbTableDef = dbDataBase.TableDefs(I)
        TableName = dbTableDef.Name
        'tova sa tablici na Access koito ne trqbva da se pipat
        If TableName <> "MSysAccessObjects" And TableName <> "MSysACEs" And TableName <> "MSysObjects" And TableName <> "MSysQueries" And TableName <> "MSysRelationships" Then
           List1.AddItem TableName
        End If
    Next I
    List1.Tag = "Tables"
    Exit Sub
InputTablesToListBoxError:
MsgBox Err.Description, vbCritical, "QuarantineDB : Error Num." & Err.Number
End Sub

Public Sub InputQueriesToListBox(List1 As ListBox)
'raboti s DAO
Dim QueriesCount As Long
Dim I As Integer
    On Error GoTo InputQueriesToListBoxError
    List1.Clear
    'broqt na kolonite
    QueriesCount = dbDataBase.QueryDefs.Count - 1
    'pupvite 6 ne sa za pokazvane (nekvi sturotii na access)
    For I = 0 To QueriesCount
        Set dbQueryDef = dbDataBase.QueryDefs(I)
        List1.AddItem dbQueryDef.Name
    Next I
    List1.Tag = "Queries"
    Exit Sub

InputQueriesToListBoxError:
MsgBox Err.Description, vbCritical, "QuarantineDB : Error Num." & Err.Number
End Sub

Public Function FindTypeConstant(strType As String) As Byte
    Select Case strType
           Case "Boolean": FindTypeConstant = 1
           Case "Byte": FindTypeConstant = 2
           Case "Integer": FindTypeConstant = 3
           Case "Long": FindTypeConstant = 4
           Case "Currency": FindTypeConstant = 5
           Case "Single": FindTypeConstant = 6
           Case "Double": FindTypeConstant = 7
           Case "Date/Time": FindTypeConstant = 8
           Case "Text": FindTypeConstant = 10
           Case "Binary": FindTypeConstant = 9
           Case "Memo": FindTypeConstant = 12
     End Select
End Function

Public Sub InputTablesToComboBox(ComboBox1 As ComboBox)
'raboti s DAO
Dim TablesCount As Long
Dim TableName As String
Dim I As Integer
    On Error GoTo InputTablesToComboBoxError
    ComboBox1.Clear
    'broqt na kolonite
    TablesCount = dbDataBase.TableDefs.Count
    'pupvite 6 ne sa za pokazvane (nekvi sturotii na access)
    For I = 0 To TablesCount - 1
        Set dbTableDef = dbDataBase.TableDefs(I)
        TableName = dbTableDef.Name
        'tova sa tablici na Access koito ne trqbva da se pipat
        If TableName <> "MSysAccessObjects" And TableName <> "MSysACEs" And TableName <> "MSysObjects" And TableName <> "MSysQueries" And TableName <> "MSysRelationships" Then
           ComboBox1.AddItem TableName
        End If
    Next I
    Exit Sub
InputTablesToComboBoxError:
MsgBox Err.Description, vbCritical, "QuarantineDB : Error Num." & Err.Number
End Sub


monggo tinggal di modifikasi  :-bd

Itu maksud code kk maksudnya menampung file sbuah virus di dalam
Mdb
atau di dlam folder tapi Mdb dijadikan sebagai lognya
-.-'
Mhon penjelesannya
Dor dor dor

Offline subma

  • Pro1
  • *
  • Tulisan: 2
  • Reputation: +32/-0
    • Lihat Profil
Re: [bantuan] tolong avb
« Jawab #8 pada: Januari 05, 2011, 11:52:19 PM »
kepada semuanya saya minta maaf terlebih dahulu ya  ^:)^
kepada mas blinkz bisa gak di tunjukan gambarnya gimana siuh jadinya gak mungkinkan kita mengetahui score codenya tapi kita tidak tahu gimana siuh jadi bentuk exenya

sekali lagi saya minta maaf
 ^:)^ ^:)^ ^:)^