BEJO'S APPLICATIONS

Monday, May 27, 2019

VB.NET – MEMBUAT FORM AKTIVASI

By May 27, 2019 No comments:

Tutorial kali ini akan menjelaskan bagaimana membuat contoh form aktivasi, yaitu form yang berfungsi untuk melakukan aktivasi software aplikasi yang kita buat. Dimana biasanya dalam form terdapat dua bagian penting yaitu Serial Number dan Activation Key. Serial Number akan unik disetiap komputer, sehingga dibutuhkan Activation Key yang unik pula.

Untuk mendapatkan Activation Key bisa gunakan tombol Generate, namun jangan lupa untuk menghapus/men-disabled tombol Generate agar tidak bisa diakses oleh pengguna software yang kita buat.

Silahkan desain form seperti gambar di bawah ini, dan buat property name nya seperti pada gambar.
Copy Kode Program ini di dalam jendela kode ACTIVATION_FORM

Imports Microsoft.Win32

Public Class ACTIVATION_FORM

Private Sub ACTIVATION_FORM_Load(sender As Object, e As EventArgs) Handles MyBase.Load

Dim serial As Long

Dim sm As New SecurityManager

Dim temp As String

Dim pjg As Integer

Dim newSerial As String = ""

serial = sm.GetSerial

temp = serial

pjg = temp.Length

For i As Integer = 1 To pjg

Dim a As String

Dim b As Integer

a = Mid(temp, i, 1)

b = Asc(a)

newSerial = newSerial & a & b Mod 2

serialTextBox.Text = newSerial

checkLicense()

Dim kg As New KeyGenerator

Dim key As String = kg.GenerateKey(serialTextBox.Text)

If activationKeyTextBox.Text <> key Then

statusLabel.ForeColor = Color.Red

statusLabel.Text = "Not Activated/invalid key"

Button1.Enabled = True

Else

statusLabel.ForeColor = Color.DarkGreen

statusLabel.Text = "Activated"

Button1.Enabled = False

End If

End Sub

Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click

Me.Close()

End Sub

Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click

'Dim serial As Long

'If Not Long.TryParse(serialTextBox.Text, serial) Then

'MessageBox.Show("Inavlid serial number")

'Exit Sub

'End If

Dim kg As New KeyGenerator

Dim key As String = kg.GenerateKey(serialTextBox.Text)

activationKeyTextBox.Text = key

End Sub

Sub checkLicense()

Dim kg As New KeyGenerator

Dim key As String = kg.GenerateKey(serialTextBox.Text)

If System.IO.File.Exists(bejoLicenseFile) Then

bejoWriteSettings(bejoLicenseFile, "LICENSE", "serial", serialTextBox.Text)

activationKeyTextBox.Text = bejoReadSettings(bejoLicenseFile, "LICENSE", "activation_key", "")

Else

bejoWriteSettings(bejoLicenseFile, "LICENSE", "serial", serialTextBox.Text)

activationKeyTextBox.Text = ""

End If

End Sub

Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click

Dim kg As New KeyGenerator

Dim key As String = kg.GenerateKey(serialTextBox.Text)

If activationKeyTextBox.Text <> key Then

statusLabel.ForeColor = Color.Red

statusLabel.Text = "Not Activated/invalid key"

MsgBox("Invalid activation key!", vbExclamation)

Else

bejoWriteSettings(bejoLicenseFile, "LICENSE", "activation_key", activationKeyTextBox.Text)

statusLabel.ForeColor = Color.DarkGreen

statusLabel.Text = "Activated"

MsgBox("Successfull Activated!", vbInformation)

End If

End Sub

End Class

Tambahkan Module1 pada project dan copy source code berikut :

Module Module1

    Public bejoDirectory As String = My.Application.Info.DirectoryPath

    Public bejoLicenseFile As String = bejoDirectory & "\license.ini"

    Private Declare Unicode Function GetPrivateProfileString Lib "kernel32" _

    Alias "GetPrivateProfileStringW" (ByVal lpApplicationName As String, _

    ByVal lpKeyName As String, ByVal lpDefault As String, _

    ByVal lpReturnedString As String, ByVal nSize As Int32, _

    ByVal lpFileName As String) As Int32

    Private Declare Unicode Function WritePrivateProfileString Lib "kernel32" _

        Alias "WritePrivateProfileStringW" (ByVal lpApplicationName As String, _

        ByVal lpKeyName As String, ByVal lpString As String, _

        ByVal lpFileName As String) As Int32

    Public Sub bejoWriteSettings(ByVal iniFileName As String, ByVal Section As String, ByVal ParamName As String, ByVal ParamVal As String)

        Dim Result As Integer = WritePrivateProfileString(Section, ParamName, ParamVal, iniFileName)

    End Sub

    Public Function bejoReadSettings(ByVal IniFileName As String, ByVal Section As String, ByVal ParamName As String, ByVal ParamDefault As String) As String

        Dim ParamVal As String = Space$(1024)

        Dim LenParamVal As Long = GetPrivateProfileString(Section, ParamName, ParamDefault, ParamVal, Len(ParamVal), IniFileName)

        bejoReadSettings = Left$(ParamVal, LenParamVal)

    End Function

End Module

Pada menu Project > Add References (beri tick pada System.Management)

Tambahkan  object Class pada project simpan dengan nama KeyGenerator.vb, lalu copy code berikut :

Public Class KeyGenerator

    Public Function GenerateKey(ByVal serial As String) As String

        Dim x As String = serial

        Dim temp As String = x * x / (x / 2) + x / 193686

        Dim a As String = ""

        For i As Integer = 0 To temp.Length - 1

            Dim s As Char = temp.Substring(i, 1)

            If s = "," Or s = "." Then

                a = a & Asc(".")

            Else

                a = a & Asc(temp.Substring(i, 1))

            End If

        Next

        Dim b As String = a.Substring(0, 5) & "-" & a.Substring(5, 5) & "-" & a.Substring(10, 5) & "-" & a.Substring(15, 5) & "-" & a.Substring(20, 5)

        Return b

    End Function

End Class
Tambahkan object Class pada project simpan dengan nama SecurityManager.vb, lalu copy code berikut :

Imports System.Management

Public Class SecurityManager

    Public Function GetSerial() As Long

        Dim mc As New ManagementClass("Win32_NetworkAdapterConfiguration")

        Dim mac As String = ""

        Dim moc As ManagementObjectCollection = mc.GetInstances

        For Each mo As ManagementObject In moc

            If mo.Item("IPEnabled") Then

                mac = mo.Item("MacAddress").ToString

            End If

        Next

        mc.Dispose()

        Dim sum As Long = 0

        Dim index As Integer = 1

        For Each ch As Char In mac

            If Char.IsDigit(ch) Then

                sum += sum + Integer.Parse(ch) * (index * 2)

            ElseIf Char.IsLetter(ch) Then

                Select Case ch.ToString.ToUpper

                    Case "A"

                        sum += sum + 10 * (index * 2)

                    Case "B"

                        sum += sum + 11 * (index * 2)

                    Case "C"

                        sum += sum + 12 * (index * 2)

                    Case "D"

                        sum += sum + 13 * (index * 2)

                    Case "E"

                        sum += sum + 14 * (index * 2)

                    Case "F"

                        sum += sum + 15 * (index * 2)

                End Select

            End If

            index += 1

        Next

        Return sum

    End Function

    Public Function CheckKey(ByVal key As Long) As Boolean

        Dim x As Long = GetSerial()

        Dim y As Long = x * x + 53 / x + 113 * (x / 4)

        Return y = key

    End Function

End Class

Yang mau download project nya dan papernya download di bawah ini :

download vb.net project

download Tutorial PDF

SCREEN CAPTURE AKTIFITAS PEMAKAI KOMPUTER

By May 09, 2019 No comments:

Asal-usul judul “SCREEN CAPTURE AKTIFITAS PEMAKAI KOMPUTER” adalah berkat suatu kejadian sering beratnya internet kantor. Saat internet terasa berat, saya langsung saja masuk ke winbox dan mencari tahu komputer siapa yang pemakaian internetnya tinggi. Dan akhirnya ketahuan sumber penyebabnya. Namun yang kelihatan hanyalah source ip address,destination ip address yang diakses dan besarnya paket yang diambil.

Dari kejadian itu saya punya inisiatif untuk membuat sebuah aplikasi yang bisa merekam aktifitas komputer dalam hal ini meng-capture (print screen) aktifitas pemakai komputer dan menyimpan file-nya lalu kemudian mengirimkan hasil capture tersebut ke alamat email saya (kirim email dalam periode waktu tertentu agar tidak terlalu membebani bandwidth internet).

Aplikasi saya buat menggunakan Visual Basic 6.0 dan EASendMailObj.dll untuk kirim email.

Download EASendMail disini.

silahkan install dulu EASendMail-nya.

Lalu di jendela visual basic ikuti langkah di bawah ini.

Di dalam Form1 masukan 3 tools yaitu 1 picturebox dan 2 buah timer. Silahkan setting Form seperti gambar di bawah ini
Tambahkan Module1 pada project (Klik kanan pada project > Add > Module)

Module1 digunakan untuk script capture screen windows, silahkan kopi script ini dan taruh di dalam Module1

Option Explicit
Option Base 0

Private Type PALETTEENTRY
    peRed   As Byte
    peGreen As Byte
    peBlue  As Byte
    peFlags As Byte
End Type

Private Type LOGPALETTE
    palVersion       As Integer
    palNumEntries    As Integer
    palPalEntry(255) As PALETTEENTRY  ' Enough for 256 colors
End Type
         
Private Type GUID
    Data1    As Long
    Data2    As Integer
    Data3    As Integer
    Data4(7) As Byte
End Type

Private Type RECT
    Left   As Long
    Top    As Long
    Right  As Long
    Bottom As Long
End Type

Private Type PicBmp
    Size As Long
    Type As Long
    hBmp As Long
    hPal As Long
    Reserved As Long
End Type

Private Const RASTERCAPS As Long = 38
Private Const RC_PALETTE As Long = &H100
Private Const SIZEPALETTE As Long = 104

Private Declare Function CreateCompatibleBitmap Lib "gdi32" ( _
    ByVal hdc As Long, ByVal nWidth As Long, _
    ByVal nHeight As Long) As Long

' Retrieves device-specific information about a specified device.
Private Declare Function GetDeviceCaps Lib "gdi32" ( _
    ByVal hdc As Long, ByVal iCapabilitiy As Long) As Long

' Retrieves a range of palette entries from the system palette
' associated with the specified DC.
Private Declare Function GetSystemPaletteEntries Lib "gdi32" ( _
    ByVal hdc As Long, ByVal wStartIndex As Long, _
    ByVal wNumEntries As Long, lpPaletteEntries As PALETTEENTRY) _
    As Long

' Creates a memory DC compatible with the specified device.
Private Declare Function CreateCompatibleDC Lib "gdi32" ( _
    ByVal hdc As Long) As Long

' Creates a logical color palette.
Private Declare Function CreatePalette Lib "gdi32" ( _
    lpLogPalette As LOGPALETTE) As Long

' Selects the specified logical palette into a DC.
Private Declare Function SelectPalette Lib "gdi32" ( _
    ByVal hdc As Long, ByVal hPalette As Long, _
    ByVal bForceBackground As Long) As Long

' Maps palette entries from the current logical
' palette to the system palette.
Private Declare Function RealizePalette Lib "gdi32" ( _
    ByVal hdc As Long) As Long

' Selects an object into the specified DC. The new
' object replaces the previous object of the same type.
' Returned is the handle of the replaced object.
Private Declare Function SelectObject Lib "gdi32" ( _
    ByVal hdc As Long, ByVal hObject As Long) As Long

' Performs a bit-block transfer of color data corresponding to
' a rectangle of pixels from the source DC into a destination DC.
Private Declare Function BitBlt Lib "gdi32" ( _
    ByVal hDCDest As Long, ByVal XDest As Long, _
    ByVal YDest As Long, ByVal nWidth As Long, _
    ByVal nHeight As Long, ByVal hDCSrc As Long, _
    ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) _
    As Long

' Retrieves the DC for the entire window, including title bar,
' menus, and scroll bars. A window DC permits painting anywhere
' in a window, because the origin of the DC is the upper-left
' corner of the window instead of the client area.
Private Declare Function GetWindowDC Lib "USER32" ( _
    ByVal hWnd As Long) As Long

' Retrieves a handle to a display DC for the Client area of
' a specified window or for the entire screen.  You can use
' the returned handle in subsequent GDI functions to draw in
' the DC.
Private Declare Function GetDC Lib "USER32" ( _
    ByVal hWnd As Long) As Long

' Releases a DC, freeing it for use by other applications.
' The effect of the ReleaseDC function depends on the type
' of DC.  It frees only common and window DCs.  It has no
' effect on class or private DCs.
Private Declare Function ReleaseDC Lib "USER32" ( _
    ByVal hWnd As Long, ByVal hdc As Long) As Long

' Deletes the specified DC.
Private Declare Function DeleteDC Lib "gdi32" ( _
    ByVal hdc As Long) As Long

' Retrieves the dimensions of the bounding rectangle of the
' specified window. The dimensions are given in screen
' coordinates that are relative to the upper-left corner
' of the screen.
Private Declare Function GetWindowRect Lib "USER32" ( _
    ByVal hWnd As Long, lpRect As RECT) As Long

' Returns a handle to the Desktop window.  The desktop
' window covers the entire screen and is the area on top
' of which all icons and other windows are painted.
Private Declare Function GetDesktopWindow Lib "USER32" () As Long

Private Declare Function GetForegroundWindow Lib "USER32" () As Long

Private Declare Function OleCreatePictureIndirect _
    Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, _
    ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
Public Function CreateBitmapPicture(ByVal hBmp As Long, _
        ByVal hPal As Long) As Picture

Dim r   As Long
Dim Pic As PicBmp
'
' IPicture requires a reference to "Standard OLE Types"
'
Dim IPic          As IPicture
Dim IID_IDispatch As GUID
'
' Fill in with IDispatch Interface ID
'
With IID_IDispatch
    .Data1 = &H20400
    .Data4(0) = &HC0
    .Data4(7) = &H46
End With
'
' Fill Pic with the necessary parts.
'
With Pic
    .Size = Len(Pic)          ' Length of structure
    .Type = vbPicTypeBitmap   ' Type of Picture (bitmap)
    .hBmp = hBmp              ' Handle to bitmap
    .hPal = hPal              ' Handle to palette (may be null)
End With
'
' Create the Picture object.
r = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic)
'
' Return the new Picture object.
'
Set CreateBitmapPicture = IPic
End Function

Public Function CaptureWindow(ByVal hWndSrc As Long, _
    ByVal bClient As Boolean, ByVal LeftSrc As Long, _
    ByVal TopSrc As Long, ByVal WidthSrc As Long, _
    ByVal HeightSrc As Long) As Picture

Dim hDCMemory       As Long
Dim hBmp            As Long
Dim hBmpPrev        As Long
Dim r               As Long
Dim hDCSrc          As Long
Dim hPal            As Long
Dim hPalPrev        As Long
Dim RasterCapsScrn  As Long
Dim HasPaletteScrn  As Long
Dim PaletteSizeScrn As Long
Dim LogPal          As LOGPALETTE
'
' Get the proper Device Context (DC) depending on the value of bClient.
'
If bClient Then
    hDCSrc = GetDC(hWndSrc)       'Get DC for Client area.
Else
    hDCSrc = GetWindowDC(hWndSrc) 'Get DC for entire window.
End If
'
' Create a memory DC for the copy process.
'
hDCMemory = CreateCompatibleDC(hDCSrc)
'
' Create a bitmap and place it in the memory DC.
'
hBmp = CreateCompatibleBitmap(hDCSrc, WidthSrc, HeightSrc)
hBmpPrev = SelectObject(hDCMemory, hBmp)
'
' Get the screen properties.
'
RasterCapsScrn = GetDeviceCaps(hDCSrc, RASTERCAPS)   'Raster capabilities
HasPaletteScrn = RasterCapsScrn And RC_PALETTE       'Palette support
PaletteSizeScrn = GetDeviceCaps(hDCSrc, SIZEPALETTE) 'Palette size
'
' If the screen has a palette make a copy and realize it.
'
If HasPaletteScrn And (PaletteSizeScrn = 256) Then
    '
    ' Create a copy of the system palette.
    '
    LogPal.palVersion = &H300
    LogPal.palNumEntries = 256
    r = GetSystemPaletteEntries(hDCSrc, 0, 256, LogPal.palPalEntry(0))
    hPal = CreatePalette(LogPal)
    '
    ' Select the new palette into the memory DC and realize it.
    '
    hPalPrev = SelectPalette(hDCMemory, hPal, 0)
    r = RealizePalette(hDCMemory)
End If
'
' Copy the on-screen image into the memory DC.
'
r = BitBlt(hDCMemory, 0, 0, WidthSrc, HeightSrc, hDCSrc, _
    LeftSrc, TopSrc, vbSrcCopy)
'
' Remove the new copy of the on-screen image.
'
hBmp = SelectObject(hDCMemory, hBmpPrev)
'
' If the screen has a palette get back the
' palette that was selected in previously.
'
If HasPaletteScrn And (PaletteSizeScrn = 256) Then
    hPal = SelectPalette(hDCMemory, hPalPrev, 0)
End If
'
' Release the DC resources back to the system.
'
r = DeleteDC(hDCMemory)
r = ReleaseDC(hWndSrc, hDCSrc)
'
' Create a picture object from the bitmap
' and palette handles.
'
Set CaptureWindow = CreateBitmapPicture(hBmp, hPal)
End Function

Public Function CaptureScreen() As Picture
Dim hWndScreen As Long
'
' Get a handle to the desktop window.
hWndScreen = GetDesktopWindow()
'
' Capture the entire desktop.
'
With Screen
    Set CaptureScreen = CaptureWindow(hWndScreen, False, 0, 0, _
            .Width \ .TwipsPerPixelX, .Height \ .TwipsPerPixelY)
End With
End Function

Tambahkan Module2 pada project (Klik kanan pada project > Add > Module)

Module2 digunakan untuk menyimpan capture ke file jpg dengan kemampuan pengaturen pixcel agar ukuran file tidak terlalu besar, silahkan kopi script ini dan taruh di dalam Module2

'Attribute VB_Name = "ModSaveAsImage"
Option Explicit
'///////////////////////////////////////////////////
'// SaveImageAs - Save hDC to Bitmap or Jpeg file //
'// Ed Wilk/Edgemeal - last updated Feb.06,2010   //
'///////////////////////////////////////////////////

'calling SaveImageAs:
'SaveImageAs "c:\mypicture.jpg", Picture1.hdc, Picture1.Width / Screen.TwipsPerPixelX, Picture1.Height / Screen.TwipsPerPixelY, 75)

Private Const BI_RGB As Long = 0
Private Const DIB_RGB_COLORS As Long = 0

Private Type BitmapFileHeader
    bfType As Integer
    bfSize As Long
    bfReserved1 As Integer
    bfReserved2 As Integer
    bfOffBits As Long
End Type

Private Type BitmapInfoHeader
  biSize As Long
  biWidth As Long
  biHeight As Long
  biPlanes As Integer
  biBitCount As Integer
  biCompression As Long
  biDataSize As Long
  biXPelsPerMeter As Long
  biYPelsPerMeter As Long
  biClrUsed As Long
  biClrImportant As Long
End Type

Private Type RGBQUAD
  rgbBlue As Byte
  rgbGreen As Byte
  rgbRed As Byte
  rgbReserved As Byte
End Type

Private Type BITMAPINFO
  bmiHeader As BitmapInfoHeader
  bmiColors As RGBQUAD
End Type

Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function CreateDIBSection Lib "gdi32" (ByVal hdc As Long, pBitmapInfo As BITMAPINFO, ByVal un As Long, ByVal lplpVoid As Long, ByVal handle As Long, ByVal dw As Long) As Long
Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long

' gdi+
Private Type GUID
   Data1 As Long
   Data2 As Integer
   Data3 As Integer
   Data4(0 To 7) As Byte
End Type

Private Type GdiplusStartupInput
   GdiplusVersion As Long
   DebugEventCallback As Long
   SuppressBackgroundThread As Long
   SuppressExternalCodecs As Long
End Type

Private Type EncoderParameter
   GUID As GUID
   NumberOfValues As Long
   Type As Long
   Value As Long
End Type

Private Type EncoderParameters
   Count As Long
   Parameter As EncoderParameter
End Type

Private Declare Function GdiplusStartup Lib "GDIPlus" ( _
   token As Long, _
   inputbuf As GdiplusStartupInput, _
   Optional ByVal outputbuf As Long = 0) As Long

Private Declare Function GdiplusShutdown Lib "GDIPlus" ( _
   ByVal token As Long) As Long

Private Declare Function GdipCreateBitmapFromHBITMAP Lib "GDIPlus" ( _
   ByVal hbm As Long, _
   ByVal hPal As Long, _
   Bitmap As Long) As Long

Private Declare Function GdipDisposeImage Lib "GDIPlus" ( _
   ByVal Image As Long) As Long

Private Declare Function GdipSaveImageToFile Lib "GDIPlus" ( _
   ByVal Image As Long, _
   ByVal filename As Long, _
   clsidEncoder As GUID, _
   encoderParams As Any) As Long

Private Declare Function CLSIDFromString Lib "ole32" ( _
   ByVal str As Long, _
   id As GUID) As Long




Public Sub SaveImageAs(ByVal sFileName As String, ByVal Source_hDC As Long, ByVal Width As Long, ByVal Height As Long, Optional ByVal Quality As Long = 80)
    Dim sFileExt As String
    Dim myDIB As Long, myDC As Long, fNum As Long
    Dim bi24BitInfo As BITMAPINFO
    Dim fileheader As BitmapFileHeader
    Dim bitmapData() As Byte
    ' gdi
    Dim tSI As GdiplusStartupInput
    Dim lRes As Long, lGDIP As Long, lBitmap As Long
    Dim tJpgEncoder As GUID
    Dim tParams As EncoderParameters
    
    ' source hDC to DIB
    With bi24BitInfo.bmiHeader
      .biBitCount = 24
      .biCompression = BI_RGB
      .biPlanes = 1
      .biSize = Len(bi24BitInfo.bmiHeader)
      .biWidth = Width
      .biHeight = Height
      .biDataSize = ((.biWidth * 3 + 3) And &HFFFFFFFC) * .biHeight
      ReDim bitmapData(0 To .biDataSize - 1)
    End With
    myDC = CreateCompatibleDC(0)
    myDIB = CreateDIBSection(myDC, bi24BitInfo, DIB_RGB_COLORS, ByVal 0&, ByVal 0&, ByVal 0&)
    SelectObject myDC, myDIB
    BitBlt myDC, 0, 0, bi24BitInfo.bmiHeader.biWidth, bi24BitInfo.bmiHeader.biHeight, Source_hDC, 0, 0, vbSrcCopy
    Call GetDIBits(myDC, myDIB, 0, bi24BitInfo.bmiHeader.biHeight, bitmapData(0), bi24BitInfo, DIB_RGB_COLORS)
        
    ' get file extension of filename to save as lower case.
    sFileExt = LCase$(GetFileExt(sFileName))
    ' Save image to file....
    Select Case sFileExt
        Case ".bmp"   ' save as bmp....
            With fileheader
                .bfType = &H4D42
                .bfOffBits = Len(fileheader) + Len(bi24BitInfo.bmiHeader)
                .bfSize = bi24BitInfo.bmiHeader.biDataSize + .bfOffBits
            End With
            fNum = FreeFile
            On Error GoTo BadFileName
            Open sFileName For Output As fNum
            Close fNum
            Open sFileName For Binary As fNum
            Put fNum, , fileheader
            Put fNum, , bi24BitInfo.bmiHeader
            Put fNum, , bitmapData()
            Close fNum
        Case ".jpg", ".png"
            tSI.GdiplusVersion = 1 ' Initialize GDI+
            lRes = GdiplusStartup(lGDIP, tSI)
            If lRes = 0 Then
                lRes = GdipCreateBitmapFromHBITMAP(myDIB, 0, lBitmap) ' Create the GDI+ bitmap from the image handle
                If lRes = 0 Then
                    If sFileExt = ".jpg" Then ' JPG
                        CLSIDFromString StrPtr("{557CF401-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder
                        ' Initialize the encoder parameters
                        tParams.Count = 1
                        With tParams.Parameter ' jpeg Quality
                          CLSIDFromString StrPtr("{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"), .GUID
                          .NumberOfValues = 1
                          .Type = 4
                          .Value = VarPtr(Quality)
                        End With
                    ElseIf sFileExt = ".png" Then ' PNG
                        CLSIDFromString StrPtr("{557CF406-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder
                    End If
                    ' Save the image
                    lRes = GdipSaveImageToFile(lBitmap, StrPtr(sFileName), tJpgEncoder, tParams)
                    ' Destroy the bitmap
                    GdipDisposeImage lBitmap
                End If
              ' Shutdown GDI+
              GdiplusShutdown lGDIP
            End If
            If lRes Then
                Err.Raise 5, , "Can not save image(GDI+ Error).:" & lRes
            End If
    End Select
Fini:
    DeleteObject myDIB
    DeleteDC myDC
    Exit Sub

BadFileName:
    Close fNum
    Err.Raise 5, , "Can not save BMP image.:" & lRes
    Resume Fini
End Sub
Private Function GetFileExt(sFile As String) As String
    ' example" returns ".exe"
    Dim i As Integer
    i = InStrRev(sFile, ".")
    If i Then
        GetFileExt = Mid$(sFile, i)
    Else
        GetFileExt = sFile ' if not found then just return the whole string
    End If
End Function

Tambahkan Module3 pada project (Klik kanan pada project >Add > Module)

Copy script berikut ke module3

Private Declare Function apiGetComputerName Lib "kernel32" Alias _
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Function fOSMachineName() As String
    Dim lngLen As Long, lngX As Long
    Dim strCompName As String
    lngLen = 16
    strCompName = String$(lngLen, 0)
    lngX = apiGetComputerName(strCompName, lngLen)
    If lngX <> 0 Then
    fOSMachineName = Left$(strCompName, lngLen)
    Else
    fOSMachineName = """"
    End If
End Function

Kembali ke Form1

Aturlah property pada control timer, dan picturebox sebagai berikut ini :

Kontrol	Property	Value
Timer1	Enabled	True
Timer1	Interval	1000
Timer2	Enabled	True
Timer2	Interval	100
Picture1	AutoRedraw	True

Buat text file manifest di dalam satu folder dengan project, penamaan file manifest mengikuti nama file exe hasil compile aplikasi (misal hasil compile adalah svchost.exe maka bikinlah file svchost.exe.manifest). Buka file svchost.exe.manifest dengan notepad lalu copy configurasi berikut ini.
Silahkan compile dan jalankan aplikasinya. (jangan lupa untuk menyertakan file EASendMailObj.dll dan svchost.exe.manifest dalam satu folder svchost.exe jika ingin menjalankan nya dikomputer lain).

DOWNLOAD PROJECT VB6

BejoApps (APLIKASI PEMBELIAN DAN PENJUALAN BARANG)

By April 24, 2019 No comments:

BEJOAPPS

Bejoapps adalah aplikasi yang dapat digunakan untuk transaksi pembelian dan penjualan barang.

Apa yang bisa dilakukan di Bejoapps?

Transaksi Pembelian Barang
Management Stok Barang
Transaksi Penjualan Barang
Laporan-laporan

FREE DOWNLOAD WINDOWS 10 32 BIT ISO

By April 11, 2019 No comments:

Siapa yang ingin download file iso master Windows 10 x86 / 32 bit silahkan klik menu download dibawah ini.
Sekian sharing saya. semoga membantu.

DOWNLOAD

VB.Net Tutorial Creating a Function Displaying Data From Table To Datagridview

By July 30, 2018 No comments:

The purpose of making this function is to facilitate and accelerate the making of the application, because every time you will display data from the table to the datagridview you simply call this function so there is no need to rewrite the long program code.

I hope you understand first how to create database and table in mysql.

Create database with name: kampus_db and create table t_mahasiswa with structure below. please execute your sql script following:

DROP DATABASE IF EXISTS kampus_db;
CREATE DATABASE kampus_db;
USE kampus_db;

DROP TABLE IF EXISTS `t_mahasiswa`;
CREATE TABLE `t_mahasiswa` (
  `id` int(5) NOT NULL AUTO_INCREMENT,
  `nim` varchar(6) NOT NULL,
  `full_name` varchar(20) NOT NULL,
  `jenis_kelamin` varchar(6) NOT NULL,
  `jurusan` varchar(30) NOT NULL,
  PRIMARY KEY (`id`),
  UNIQUE KEY `nim` (`nim`)
) ENGINE=InnoDB DEFAULT CHARSET=latin1;

INSERT INTO t_mahasiswa (nim,full_name,jenis_kelamin,jurusan) VALUES
  ('100201','FRANSISKUS SUTRIS','PRIA','TEKNIK INFORMATIKA'),
  ('101202','MUHAMMAD ILHAM','PRIA','SISTEM INFORMASI'),
  ('102203','FRANSISKA HANDANI','WANITA','MANAJEMEN');

Add Mysql.Data.dll in Project Reference

Add a Module and name it Module1.vb, then copy the following program code :

Imports MySql.Data.MySqlClient
Module Module1
    Public conn As New MySqlConnection
    Public errorDescription As String
    Public server As String = "127.0.0.1" 'silahkan disesuaikan
    Public username As String = "root" 'disesuaikan /user default mysql adalah root
    Public password As String = "12345678" 'ini password root ditempat saya
    Public database_name As String = "kampus_db"

    Public Function bejoDBConnect() As String
        'fungsi koneksi ke mysql database
        If Not conn Is Nothing Then conn.Close()
        conn.ConnectionString = String.Format("server={0}; user id={1}; password={2}; database={3}; pooling=false; Convert Zero Datetime=True", server, username, password, database_name)
        Try
            conn.Open()
            Return "OK"
        Catch ex As Exception
            errorDescription = ex.Message
            Return ex.Message
        End Try

    End Function
     Sub showDataToDGV(sql As String, tabelName As String, dgv As DataGridView)
  'fungsi menampilkan data ke datagridview
     bejoDBConnect()
     Try
          Dim com As String = sql
          Dim Adpt As New MySqlDataAdapter(com, conn)
          Dim ds As New DataSet()
          Adpt.Fill(ds, tabelName)
          dgv.DataSource = ds.Tables(0)
     Catch ex As Exception
          MsgBox(ex.Message, vbCritical)
     End Try
    End Sub
End Module

Please add Windows Form and leave the name Form2.vb, drag the datagridview control into form2, add the Button to the form2 as shown below:

Double Click on control Button 1, then copy the following program code on sub Button1_Click :

Cursor.Current = Cursors.WaitCursor
showDataToDGV("Select * FROM t_mahasiswa", "t_mahasiswa", DataGridView1)
Cursor.Current = Cursors.Default

The full program code in form2.vb is as follows :

Please change the Startup Form on the project properties to Form2. Then try press F5 to run the program. When executed and Button1 is clicked then student data from table t_mahasiswa will appear in datagridview:

So every time you will display data from table to datagridview just call the showDataToDGV function.

showDataToDGV(sql As String, tabelName As String, dgv As DataGridView)

Explanation Function showDataToDGV :

Parameter	Description
sql	sql query to read data with prefixed commands select
tableName	selected table names
dgv	control name datagridview which will be used to display data

Tutorial VB.Net Membuat Fungsi Menampilkan Data Dari Tabel Ke Datagridview

By July 27, 2018 No comments:

Tujuan dari membuat fungsi ini adalah agar mempermudah sekaligus mempercepat pembuatan aplikasi, karena setiap kali anda akan menampilkan data dari tabel ke datagridview anda cukup memanggil fungsi ini sehingga tidak perlu menulis ulang kode program yang panjang.

Saya harap anda sudah memahami dahulu bagaimana membuat database dan table di mysql.

Buat database dengan nama : kampus_db dan buat tabel t_mahasiswa dengan struktur di bawah ini. silahkan anda execute script sql berikut:

DROP DATABASE IF EXISTS kampus_db;
CREATE DATABASE kampus_db;
USE kampus_db;

DROP TABLE IF EXISTS `t_mahasiswa`;
CREATE TABLE `t_mahasiswa` (
  `id` int(5) NOT NULL AUTO_INCREMENT,
  `nim` varchar(6) NOT NULL,
  `full_name` varchar(20) NOT NULL,
  `jenis_kelamin` varchar(6) NOT NULL,
  `jurusan` varchar(30) NOT NULL,
  PRIMARY KEY (`id`),
  UNIQUE KEY `nim` (`nim`)
) ENGINE=InnoDB DEFAULT CHARSET=latin1;

INSERT INTO t_mahasiswa (nim,full_name,jenis_kelamin,jurusan) VALUES
  ('100201','FRANSISKUS SUTRIS','PRIA','TEKNIK INFORMATIKA'),
  ('101202','MUHAMMAD ILHAM','PRIA','SISTEM INFORMASI'),
  ('102203','FRANSISKA HANDANI','WANITA','MANAJEMEN');

Tambahkan Mysql.Data.dll dalam Project Reference

Tambahkan Modul dan beri nama Modul1.vb, lalu kopikan kode program berikut :

Imports MySql.Data.MySqlClient
Module Module1
    Public conn As New MySqlConnection
    Public errorDescription As String
    Public server As String = "127.0.0.1" 'silahkan disesuaikan
    Public username As String = "root" 'disesuaikan /user default mysql adalah root
    Public password As String = "12345678" 'ini password root ditempat saya
    Public database_name As String = "kampus_db"

    Public Function bejoDBConnect() As String
        'fungsi koneksi ke mysql database
        If Not conn Is Nothing Then conn.Close()
        conn.ConnectionString = String.Format("server={0}; user id={1}; password={2}; database={3}; pooling=false; Convert Zero Datetime=True", server, username, password, database_name)
        Try
            conn.Open()
            Return "OK"
        Catch ex As Exception
            errorDescription = ex.Message
            Return ex.Message
        End Try

    End Function
     Sub showDataToDGV(sql As String, tabelName As String, dgv As DataGridView)
  'fungsi menampilkan data ke datagridview
     bejoDBConnect()
     Try
          Dim com As String = sql
          Dim Adpt As New MySqlDataAdapter(com, conn)
          Dim ds As New DataSet()
          Adpt.Fill(ds, tabelName)
          dgv.DataSource = ds.Tables(0)
     Catch ex As Exception
          MsgBox(ex.Message, vbCritical)
     End Try
    End Sub
End Module

Silahkan tambahkan Windows Form dan biarkan namanya Form2.vb, drag control datagridview ke dalam form2, tambahkan juga Button ke dalam form2 seperti gambar berikut ini:

Double Click pada kontrol Button1, lalu kopikan kode program berikut ini pada sub Button1_Click :

Cursor.Current = Cursors.WaitCursor
showDataToDGV("Select * FROM t_mahasiswa", "t_mahasiswa", DataGridView1)
Cursor.Current = Cursors.Default

Kode program lengkapnya pada form2.vb adalah seperti berikut :

Silahkan ubah Startup Form pada project properties menjadi Form2. Lalu coba tekan F5 untuk menjalankan programnya. Ketika dijalankan dan Button1 diklik maka data mahasiswa dari tabel t_mahasiswa akan tampil di dalam datagridview:

Jadi setiap kali anda akan menampilkan data dari tabel ke datagridview cukup panggil saja fungsi showDataToDGV.

showDataToDGV(sql As String, tabelName As String, dgv As DataGridView)

Penjelasan Fungsi showDataToDGV :

Parameter	Deskripsi
sql	sql query untuk membaca data dengan diawali perintah select
tableName	nama tabel yang diseleksi
dgv	nama kontrol datagridview yang akan digunakan untuk menampilkan data

BEJO'S APPLICATIONS

Monday, May 27, 2019

VB.NET – MEMBUAT FORM AKTIVASI

Thursday, May 9, 2019

SCREEN CAPTURE AKTIFITAS PEMAKAI KOMPUTER

Wednesday, April 24, 2019

BejoApps (APLIKASI PEMBELIAN DAN PENJUALAN BARANG)

Thursday, April 11, 2019

FREE DOWNLOAD WINDOWS 10 32 BIT ISO

Monday, July 30, 2018

VB.Net Tutorial Creating a Function Displaying Data From Table To Datagridview

Friday, July 27, 2018

Tutorial VB.Net Membuat Fungsi Menampilkan Data Dari Tabel Ke Datagridview

Subcribe My Channel

Popular Posts

Find us on Facebook

Advertisement

Instagram posts

About us