Saturday 28 February 2015

DELPHI7 :: Membaca SMS dari PC

Format PDU
Hal pertama yang saya bahas adalah, bahwa setiap pengiriman SMS, baik dari HP menuju operator, atau sebaliknya, selalu menggunakan format PDU (Protocol Data Unit), yaitu paket data dimana pesan SMS dikemas, bersama informasi tanggal, nomor tujuan, nomor pengirim, nomor operator, jenis skema SMS, masa valid SMS, dan beberapa hal lain (tergantung jenis paketnya).
Berikut ini adalah contoh PDU yang diterima oleh HP (New SMS atau Inbox):
07 91 2658050000F0 04 0C 91 265836164900 00 00 506020 31133180 04 C830FB0D
Dengan keterangan sebagai berikut:
Oktet / Digit HexaKeterangan
07Panjang atau jumlah pasangan digit dari nomor SMSC (service number) yang digunakan, dalam hal ini adalah 7 pasangan (14 digit berikutnya)
91Jenis nomor SMSC. Angka 91 menandakan format nomor internasional (misal +6281xxx). Untuk 081xxx menggunakan angka 81.
2658050000F0Nomor SMSC yang digunakan. Karena jumlah digit nomor SMS adalah ganjil, maka digit paling belakang dipasangkan dengan huruf F. Kalau diterjemahkan, nomor SMSC yang digunakan adalah +62855000000 (IM3)
04Oktet pertama untuk pesan SMS yang diterima
0BPanjang digit dari nomor pengirim (0C hex = 12 desimal)
91Jenis nomor pengirim (sama dengan jenis nomor SMSC)
265836164900Nomor pengirim SMS, yang jika diterjemahkan adalah +628563619400
00Pengenal protokol, dalam hal ini adalah 0
00Skema pengkodean SMS, juga bernilai 0
506020 311331 80Waktu pengiriman, yang berarti 05-06-02 (2 Juni 2005), dan jam 13:31:13. Sedangkan 80 adalah Timezone yang digunakan.
04Panjang dari pesan SMS, dalam hal ini adalah 4 huruf (dalam mode 7 bit).
C830FB0DPesan SMS dalam mode 7 bit. Jika diterjemahkan kedalam 8 bit, lalu dirubah ke ASCII, maka didapat pesan 'Halo'
Yah, itu adalah sekilas tentang PDU, yang sering dihadapi untuk berurusan dengan SMS. Kecuali jika HP yang anda gunakan mendukung AT+CMGF=1, yang berarti kita dapat berkomunikasi dengan HP dalam Mode Teks! seperti HP saya, SE T610 :-)
Kalau menggunakan mode teks, anda tidak berurusan dengan PDU, meski antara HP dengan operator masih menggunakan PDU.
Secara online, anda dapat menerjemahkan PDU kedalam mode teks, dengan menggunakan link ini:http://home.student.utwente.nl/
Koneksi ke PC
Selanjutnya, adalah menghubungkan HP anda dengan PC. Banyak alternatif untuk itu, diantaranya:
  • Menggunakan kabel data. Biasanya spesifik untuk setiap merk HP. Nokia punya sendiri, siemens juga punya, semoga anda juga punya :-)
    Kabel ini akan menancap di port COM, atau ada juga yang di USB port.
  • Menggunakan IrDA (Infrared). Nantinya akan tercipta sebuah port COM virtual.
  • Menggunakan Bluetooth, juga menciptakan port COM bayangan.
Yang sangat perlu diperhatikan, jika anda menggunakan kabel data sebagai alat koneksi, silakan lakukan di Windows 98, karena Direct Port Programming di Windows XP/2000 sangat rumit, dan tidak menjamin kebenarannya :-)
Anda boleh menggunakan HP jenis apapun, yang penting punya kabel datanya, dan musti support AT-Command.
Dulu saya sempat debat sama temen saya, tentang apakah semua HP support AT-Command. Sampai saat ini saya masih percaya kalau ada HP yang tidak support AT-Command.
HP yang saya gunakan adalah Siemens C35i, dengan kabel data serial hasil pinjaman :-)
Setelah punya HP dan kabelnya, silakan pasang ditempat yang seharusnya, dan pastikan HP dalam keadaan nyala.
Jika anda menggunakan IrDA atau Bluetooth, pastikan bahwa sudah tercipta port COM (biasanya dengan nomor tertinggi, misal COM4 atau COM5).
Programming
Silakan buka Borland Delphi. Saya sarankan untuk memakai Delphi versi 6 ke atas, karena ada fungsi SecondsBetween yang saya sukai :-)
Ketika pertama kali masuk delphi, ada 1 komponen yang mesti kita install terlebih dahulu, yaitu MS-Comm, yang digunakan untuk berkomunikasi dengan Port COM. Cara instalasi adalah sebagai berikut:
  • Dari IDE Delphi, pada menu Component, pilih menu Import Active-X Control
  • Pada pilihan obyek, silakan pilih MSCommXX.ocx, lalu tekan tombol Install
  • Akan muncul beberapa dialog berikutnya, pilih saja yes atau ok :-)
Setelah Active-X terinstall, pada Tab Palette Active-X, akan muncul sebuah tombol dengan gambar telepon. Klik dan letakkan komponen tersebut pada Form, maka akan tercipta sebuah obyek dengan nama MSComm1.
Komunikasi
Buat sebuah tombol (Command Button) pada Form, beri caption 'Konek'. Lalu pada event On-Click tombol tersebut, ketik program berikut ini:
procedure TForm1.Button1Click(Sender: TObject);
var waktu: tDateTime;
buffer: string;
konek: boolean;
begin
if MSComm1.PortOpen then
MSComm1.PortOpen := false;
MSComm1.CommPort := 1;
// isi dengan nomor COM
// yang terhubung ke HP,
// misal COM1, isi dengan 1
MSComm1.Settings := '19200,N,8,1';
// sesuaikan baudrate
// dengan HP anda.
// kebanyakan support 19200
MSComm1.InputLen := 0;
MSComm1.PortOpen := true;

Sleep(800);
waktu := now;
repeat
MSComm1.Output := 'ATE1'#13;
buffer := '';
repeat
buffer := buffer + MSComm1.Input;
until (Pos('OK', buffer) > 0) or
(Pos('ERROR', buffer) > 0)
or (secondsbetween(waktu, now) > 10);
until (Pos('OK', buffer) > 0) or
(secondsbetween(waktu, now) > 10);
Konek := (Pos('OK', buffer) > 0);
If Konek Then
MessageDlg('Sukses konek ke HP',
mtInformation, [mbOk], 0)
else
MessageDlg('Tidak dapat konek ke HP',
mtError, [mbOk], 0);
end;
Jalankan program, semoga tidak error. Lalu tekan tombol Button1. Jika koneksi sukses, yaitu jika HP merespon perintah 'ATE1' dengan ucapan 'OK', berarti koneksi dengan HP telah berhasil. Jika tidak, mungkin terjadi kekeliruan pada kabel, nomor Port atau setting BaudRate. Silakan dicek.
Membaca SMS
Berikutnya adalah membaca SMS.
Silakan tambahkan obyek Memo pada form, dan tambahkan tombol Button2, kemudian tuliskan kode ini pada event OnClick Button2:
procedure TForm1.Button2Click(Sender: TObject);
var waktu: tDateTime;
buffer: string;
begin
MSComm1.Output := 'AT+CMGL=1' + #13;
Sleep(500);
waktu := now;
repeat
buffer := MSComm1.Input;
Memo1.Text := Memo1.Text + buffer;
until (pos(sOK, s) > 0) or (pos(sERROR, s) > 0) or
(SecondsBetween(waktu,now) > 180);
end;
Jika program dijalankan, lalu ditekan tombol Button2, maka program akan mengirim perintah AT+CMGL=1 ke HP, yang berarti, 'berikan aku daftar SMS yang ada di Inbox'. Sehingga nantinya semua isi Inbox akan dikirimkan ke program, tetapi masih dalam format PDU.
Untuk menterjemahkan dari PDU menjadi teks, diperlukan rutin lagi. Silakan download source baca SMS, yang merupakan unit untuk membaca SMS
Silakan gunakan unit tersebut pada aplikasi anda ini, lalu buat tombol Button3. Pada event OnClick Button3, tulis program singkat ini:
procedure TForm1.Button3Click(Sender: TObject);
begin
CekSMS(Memo1);
end;
Ketika tombol Button3 ditekan, maka SMS dalam Inbox dan SMS baru, akan dimasukkan kedalam Memo1.
Berikut ini ketentuan AT+CMGL,
  • AT+CMGL=0 : SMS baru
  • AT+CMGL=1 : SMS dalam Inbox (yang sudah terbaca)
  • AT+CMGL=2 : SMS Draft (belum terkirim)
  • AT+CMGL=3 : SMS Outbox (terkirim)
  • AT+CMGL=4 : Seluruh SMS (semua yang ada di Inbox, Outbox, Draft)
Daftar lengkap perintah AT-Command dapat diperoleh disini: namun kadang ada HP yang tidak support AT-Command tertentu.
#bengkelprogram

DELPHI7 :: Cara Mengirim SMS dari PC

struktur PDU untuk dikirim:
07 91 2658050000F0 11 00 0C 91 265836164900 00 00 FF 04 C830FB0D
Keterangan:
Oktet / Digit HexaKeterangan
07Panjang atau jumlah pasangan digit dari nomor SMSC (service number) yang digunakan, dalam hal ini adalah 7 pasangan (14 digit berikutnya)
91Jenis nomor SMSC. Angka 91 menandakan format nomor internasional (misal +6281xxx). Untuk 081xxx menggunakan angka 81.
2658050000F0Nomor SMSC yang digunakan. Karena jumlah digit nomor SMS adalah ganjil, maka digit paling belakang dipasangkan dengan huruf F. Kalau diterjemahkan, nomor SMSC yang digunakan adalah +62855000000 (IM3)
11Oktet pertama untuk PDU SMS untuk dikirim (SMS SUBMIT). Untuk penjelasannya, silakan lihat artikel ini.
00TP-Message-Reference. Diisi "00" agar diisi otomatis oleh handphone.
0CPanjang digit dari nomor penerima (0C hex = 12 desimal)
91Jenis nomor penerima (sama dengan jenis nomor SMSC)
265836164900Nomor penerima SMS, yang jika diterjemahkan adalah +628563619400
00Pengenal protokol, dalam hal ini adalah 0. Silakan baca keterangan di sini.
00Skema pengkodean SMS, juga bernilai 0.
FFValiditas waktu. FF berarti maksimum. Silakan baca keterangan di sini.
04Panjang dari pesan SMS, dalam hal ini adalah 4 huruf (dalam mode 7 bit).
C830FB0DPesan SMS dalam mode 7 bit. Jika diterjemahkan kedalam 8 bit, lalu dirubah ke ASCII, maka didapat pesan 'Halo'
Untuk handphone tertentu, kita dapat menghilangkan pemberian nomor SMSC pada PDU, untuk kemudian akan diisi oleh handphone sesuai dengan kartu yang sedang digunakan. Tapi untuk lebih amannya, kita sebutkan nomor SMSC yang digunakan.
Ketika PDU SMS selesai dibentuk, maka langkah selanjutnya adalah melakukan pengiriman PDU tersebut melalui port serial yang digunakan. Perintah yang pertama kali digunakan adalah AT+CMGS, dengan aturan sebagai berikut:
AT+CMGS=<jumlah oktet PDU>
<jumlah oktet PDU> diisi dengan jumlah pasangan dalam PDU yang terbentuk, dengan dikurangi SMSC. Dengan kata lain, kita menghitung jumlah oktet mulai dari kode SMS SUBMIT (11). Untuk contoh di atas, berarti jumlah digit dalam PDU adalah 36, yang berarti terdiri dari 18 oktet. Sehingga perintah yang digunakan adalah:
AT+CMGS=18
Setelah itu, tunggu respon dari handphone. Kalau gagal, dengan berbagai alasan, maka yang dikembalikan adalah ERROR.
Sedangkan jika perintah tersebut diijinkan, maka yang dikembalikan adalah karakter '>' (lebih besar).
Jika perintah tersebut sukses, selanjutnya adalah menuliskan semua PDU tersebut ke handphone, dan diakhiri dengan penulisan karakter ASCII 26 (CTRL+Z).
Jika sukses, maka yang dikembalikan adalah OK. SMS terkirim, semoga.
Dari semua penjelasan di atas, diharapkan dapat dipahami langkah-langkah pengiriman SMS melalui PC. Untuk lebih jelasnya, silakan download source-code dalam program Delphi. Unit ini dapat digabungkan dengan unit untuk membaca SMS pada artikel sebelumnya.
Yang perlu diperhatikan adalah tentang pengaturan koneksinya. Karena masing-masing proses (kirim dan terima) membutuhkan koneksi ke handphone, maka harus diatur agar tidak terjadi proses terima dan kirim secara bersamaan.
#bengkelprogram

VB.NET :: Konsep Code Generator Dan Implementasinya




Prinsip dasar code template yang kita gunakan adalah berdasarkan keteraturan yang telah digambarkan pada artikel sebelumnya, penamaan pada tiap komponen code template diambil dari parameter yang kita dapatkan dari database.

Design UI.

Sebelum mulai ke level code, mari kita membuat interface untuk code generator kita, ikutilah langkah -langkahnya sebagai berikut :

1. Buatlah Tampilan seperti terlihat pada gambar dibawah ini 


Berikut Daftar Control dan keterangannya :

Jenis KomponenNamaText
FormForm1FormMain
SplitContainerSplitContainer1
ToolStripToolStrip1
ToolStripLabelToolStripLabel1Database
ToolStripComboBoxToolStripComboBox1
ListBoxLstTable
TableLayoutPanelTableLayoutPanel2
ButtonBtnGenerateAllClassGenerate All Class
ButtonBtnGenerateClassGenerate Class
TabControlTabControl2
TabPageTabPage1Class
TextBoxClassTextBox
TabPageTabPage2Stored Procedure
TextBoxStoredProcedureTextBox

Code Template.

Setelah selesai dengan design UI, mari kita mulai membuat codenya, bukalah code designer dari FormMain, kemudian ikuti imports item dan deklarasi seperti pada contoh berikut :

Deklarasi.

Imports System.Data.SqlClient
Imports System.IO

Public Class FormMain
  Dim MyConnection As String
  Dim SQL As String
  Dim Conn As New SqlConnection(MyConnection)
  Dim CMD As New SqlCommand(SQL, Conn)
  Dim RS As SqlDataReader
  Dim MyDetailTableName As String
  Dim TablePrefix As String = "tbl"

End Class

Pada code diatas terlihat sebuah variable TablePrefix, variable tersebut digunakan untuk menghilangkan prefix pada penamaan table dalam database, sebagai contoh apabila table dalam database selalu menggunakan penamaan seperti : tblBarang, maka penamaan yang akan dibaca oleh code generator adalah Barang.

Form1_Load.

 Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
    Conn.ConnectionString = "Data Source=.;Initial Catalog=master;Integrated Security=True;"
    Try
      Conn.Open()
      Conn.Close()
    Catch ex As Exception
      Conn.Close()
      MsgBox("gagal konek")
      Exit Sub
    End Try
    SQL = "Select Name From sys.databases order by name asc"
    Conn.Open()
    CMD.CommandText = SQL
    RS = CMD.ExecuteReader
    Do Until RS.Read = False
      Dim ch As New TreeNode
      CboDatabase.Items.Add(RS("Name"))
    Loop
    Conn.Close()
  End Sub

CboDatabase_SelectedIndexChanged.

Private Sub CboDatabase_SelectedIndexChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles CboDatabase.SelectedIndexChanged
    LstTable.Items.Clear()
    MyConnection = "Data Source=.;Initial Catalog=" & CboDatabase.Text & ";Integrated Security=True;"
    Conn.ConnectionString = MyConnection

    SQL = "Select Name From sys.tables order by name asc"
    Conn.Open()
    CMD.CommandText = SQL
    RS = CMD.ExecuteReader
    Do Until RS.Read = False
      Dim ch As New TreeNode
      LstTable.Items.Add(RS("Name"))
    Loop
    Conn.Close()
    If LstTable.Items.Count > 0 Then LstTable.SelectedIndex = 0

  End Sub

BtnGenerateClass_Click.

Private Sub BtnGenerateClass_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnGenerateClass.Click
    GenerateClass(LstTable.SelectedIndex)
  End Sub

BtnGenerateAllClass_Click.

Private Sub BtnGenerateAllClass_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnGenerateAllClass.Click
    For i As Integer = 0 To LstTable.Items.Count - 1
      GenerateClass(i)
    Next
  End Sub

Fungsi GetDataType.

Fungsi GetDataType berguna untuk mendapatkan tipe data dari database yang nantinya akan kita terjemahkan kedalam tipe data VB.net, tambahkan function ini kedalam form1, berikut codenya.

Function GetDataType(ByVal TypeID As Integer) As String
  Dim xConn As New SqlConnection("Data Source=.;Initial Catalog=master;Integrated Security=True;")
    Dim xCMD As New SqlCommand("", xConn)
    Dim xRS As SqlDataReader
    Dim MyDataType As String
    xConn.Open()
    xCMD.CommandText = "Select name From sys.types where system_type_id=" & TypeID
    xRS = xCMD.ExecuteReader
    xRS.Read()
    MyDataType = xRS("name")
    xConn.Close()

    Select Case LCase(MyDataType)
      Case "bigint" : MyDataType = "Double"
      Case "int" : MyDataType = "Integer"
      Case "bit" : MyDataType = "Boolean"
      Case "date" : MyDataType = "Date"
      Case "datetime" : MyDataType = "DateTime"
      Case "varchar" : MyDataType = "String"
      Case "nvarchar" : MyDataType = "String"
      Case "time" : MyDataType = "Time"
      Case "tinyint" : MyDataType = "Integer"
      Case "smallint" : MyDataType = "Integer"
    End Select

    Return MyDataType
  End Function

Dari code diatas, anda dapat menambahkan berbagai tipe data yang anda butuhkan atau gunakan dalam database anda.

Fungsi GetPrimaryKey.

Fungsi GetPrimaryKey digunakan untuk mengambil informasi field mana dalam table yang terpilih yang menjadi primary key, fungsi ini berguna untuk secara otomatis membuat fungsi memanggil object berdasarkan field primary key nya, berikut codenya.

 Function GetPrimaryKey(ByVal MyTableName As String) As String
    Dim MyKey As String
    MyConnection = "Data Source=.;Initial Catalog=" & CboDatabase.Text & ";Integrated Security=True;"
    SQL = "SELECT column_name FROM INFORMATION_SCHEMA.KEY_COLUMN_USAGE " & _
          "WHERE OBJECTPROPERTY(OBJECT_ID(constraint_name), 'IsPrimaryKey') = 1 " & _
          "AND table_name='" & TablePrefix & MyTableName & "'"
    Conn.Open()
    CMD.CommandText = SQL
    RS = CMD.ExecuteReader
    RS.Read()
    MyKey = RS("column_name")
    Conn.Close()
    Return MyKey
  End Function

Apabila anda mempunyai table yang tidak memiliki primary key, nanti anda akan harus memodifikasi sedikit hasil codenya.

Fungsi GenerateClass.

Sub GenerateClass(ByVal xIndex As Integer)
    Dim tbl As Integer
    Dim MyTable As String
    Dim MyPrimaryKey As String

    ClassTextBox.Text = ""
    LstTable.SelectedIndex = xIndex
   
    ClassTextBox.Text = ""
    SQL = "Select Object_ID From sys.Tables where name='" & LstTable.Text & "'"
    Conn.Open()
    CMD.CommandText = SQL
    RS = CMD.ExecuteReader
    RS.Read()
    tbl = RS("Object_ID")
    Conn.Close()

    MyTable = Mid(LstTable.Text, TablePrefix.Length + 1)
    MyPrimaryKey = GetPrimaryKey(MyTable)
    ClassTextBox.Text = "Imports System.Data.SQLClient"
    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & "Public Class " & MyTable
    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & "Dim Bind as BindingSource"

    Application.DoEvents()
    '--generate property
    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbCrLf & "#Region ""Properties"""

    Dim MyListOfField As New Collection
    SQL = "Select Name, system_type_id From sys.columns where object_id=" & tbl & " Order By column_id"
    Conn.Open()
    CMD.CommandText = SQL
    RS = CMD.ExecuteReader
    Do Until RS.Read = False
      MyListOfField.Add(RS("Name") & "," & RS("system_type_id"))
    Loop
    Conn.Close()

    Dim Arr() As String
    For i As Integer = 1 To MyListOfField.Count
      Arr = Split(MyListOfField(i), ",")
      ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbCrLf & "Private x" & Arr(0) & " As " & GetDataType(Arr(1))
      ClassTextBox.Text = ClassTextBox.Text & vbCrLf & "Public Property " & Arr(0) & "() As " & GetDataType(Arr(1))
      ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbTab & "Get"
      ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbTab & vbTab & "Return x" & Arr(0)
      ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbTab & "End Get"
      ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbTab & "Set (byval value As " & GetDataType(Arr(1)) & ")"
      ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbTab & vbTab & "x" & Arr(0) & " = value"
      ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbTab & "End Set"
      ClassTextBox.Text = ClassTextBox.Text & vbCrLf & "End Property"
    Next
    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbCrLf & "#End Region"
    '--/

    Application.DoEvents()
    '--generate Standard methods
    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbCrLf & "#Region ""Standard Methods"""

    '--[create SP for Get Object]
    StoredProcedureTextBox.Text = "Begin Transaction"
    StoredProcedureTextBox.Text = StoredProcedureTextBox.Text & vbCrLf & "Create Procedure Get_" & MyTable & "_By" & MyPrimaryKey
    StoredProcedureTextBox.Text = StoredProcedureTextBox.Text & vbCrLf & "(@" & MyPrimaryKey & " Int)"
    StoredProcedureTextBox.Text = StoredProcedureTextBox.Text & vbCrLf & "As"
    StoredProcedureTextBox.Text = StoredProcedureTextBox.Text & vbCrLf & vbTab & "Select * From TBL_" & MyTable & " Where " & MyPrimaryKey & " = @" & MyPrimaryKey
    StoredProcedureTextBox.Text = StoredProcedureTextBox.Text & vbCrLf & "Return"
    StoredProcedureTextBox.Text = StoredProcedureTextBox.Text & vbCrLf
    '--[]/

    '--[get Object]
    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbCrLf & "Public Function Get_" & MyTable & "_By" & MyPrimaryKey & "(ByVal My" & MyPrimaryKey & " As Integer) As " & MyTable
    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbTab & "Dim My" & MyTable & " As New " & MyTable
    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbTab & "Using DataTable As DataTable = ExecuteDataTable(""Get_" & MyTable & "_By" & MyPrimaryKey & """, New SqlParameter(""" & MyPrimaryKey & """, My" & MyPrimaryKey & "))"
    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbTab & vbTab & "If DataTable IsNot Nothing AndAlso DataTable.Rows.Count > 0 Then "
    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbTab & vbTab & vbTab & "With DataTable.Rows(0)"

    For i As Integer = 1 To MyListOfField.Count
      Arr = Split(MyListOfField(i), ",")
      ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbTab & vbTab & vbTab & vbTab & "If Not IsDBNull(.Item(" & Arr(0) & ")) Then My" & MyTable & "." & Arr(0) & " = .Item(" & Arr(0) & ")"
    Next

    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbTab & vbTab & vbTab & "End With"
    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbTab & vbTab & "End IF"
    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbTab & "End Using"
    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbTab & "Return My" & MyTable
    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & "End Function"
    '--[]/

    Application.DoEvents()

    '--[create SP for Get Object]
    StoredProcedureTextBox.Text = StoredProcedureTextBox.Text & vbCrLf & "Create Procedure Get_" & MyTable & "_List"
    StoredProcedureTextBox.Text = StoredProcedureTextBox.Text & vbCrLf & "As"
    StoredProcedureTextBox.Text = StoredProcedureTextBox.Text & vbCrLf & vbTab & "Select * From TBL_" & MyTable & " Order By " & MyPrimaryKey
    StoredProcedureTextBox.Text = StoredProcedureTextBox.Text & vbCrLf & "Return"
    StoredProcedureTextBox.Text = StoredProcedureTextBox.Text & vbCrLf
    StoredProcedureTextBox.Text = StoredProcedureTextBox.Text & vbCrLf & "Commit"
    StoredProcedureTextBox.Text = StoredProcedureTextBox.Text & vbCrLf & "End Transaction"
    '--[]/

    '--[get list of object]
    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbCrLf & "Public Function Get_" & MyTable & "_List() As List(of " & MyTable & ")"
    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbTab & "Dim MyList" & MyTable & " As New List(of " & MyTable & ")"
    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbTab & "Using DataTable As DataTable = ExecuteDataTable(""Get_" & MyTable & "_List"")"
    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbTab & vbTab & "If DataTable IsNot Nothing AndAlso DataTable.Rows.Count > 0 Then"
    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbTab & vbTab & vbTab & "For i As Integer = 0 To DataTable.Rows.Count - 1"
    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbTab & vbTab & vbTab & vbTab & "With DataTable.Rows(i)"
    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbTab & vbTab & vbTab & vbTab & vbTab & "Dim My" & MyTable & " As New " & MyTable

    For i As Integer = 1 To MyListOfField.Count
      Arr = Split(MyListOfField(i), ",")
      ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbTab & vbTab & vbTab & vbTab & vbTab & "IF Not IsDBNull(.Item(" & Arr(0) & ")) then My" & MyTable & "." & Arr(0) & " = .Item(" & Arr(0) & ")"
    Next

    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbTab & vbTab & vbTab & vbTab & vbTab & "MyList" & MyTable & ".Add(My" & MyTable & ")"
    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbTab & vbTab & vbTab & vbTab & "End With"
    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbTab & vbTab & vbTab & "Next"
    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbTab & vbTab & "End IF"
    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbTab & "End Using"
    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbTab & "Return MyList" & MyTable
    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & "End Function"
    '--[]/

    Application.DoEvents()
    '--[Add Data sub routine]
    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & "Public Sub Add_" & MyTable & "()"
    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbTab & "Dim QueryCollection" & MyTable & " As New Collection"
    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbTab & "Dim MyQueryTransaction As QueryTransaction = QueryTransaction_Add()"
    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbTab & "QueryCollection" & MyTable & ".Add(MyQueryTransaction)"
    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbTab & "Dim Result As String = DAC.SaveTransaction(QueryCollection)"
    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & "End Sub"
    '--[]/

    '--[Update Data sub routine]
    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & "Public Sub Update_" & MyTable & "()"
    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbTab & "Dim QueryCollection" & MyTable & " As New Collection"
    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbTab & "Dim MyQueryTransaction As QueryTransaction = QueryTransaction_Update()"
    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbTab & "QueryCollection" & MyTable & ".Add(MyQueryTransaction)"
    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbTab & "Dim Result As String = DAC.SaveTransaction(QueryCollection)"
    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & "End Sub"
    '--[]/

    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbCrLf & "#End Region"
    '--/

    ' create custom method region
    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbCrLf & "#Region ""Custom Methods"""
    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbCrLf & ""
    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbCrLf & "#End Region"

    ClassTextBox.Text = ClassTextBox.Text & vbCrLf & vbCrLf & "End Class "
    File.WriteAllText(Application.StartupPath & "\Generated Class\" & MyTable & ".vb", ClassTextBox.Text)
  End Sub

Demikian contoh sederhana pembuatan code generator, anda tentunya dapat menambahkan sendiri fungsi - fungsi yang anda butuhkan, semoga bermanfaat.

Source : surya-pradhana

VB.NET :: Membuat Web Crawler Sederhana Dengan VB.Net


Web crawler adalah sebuah bot internet yang secara sistematis menelusuri World Wide Web, biasanya untuk tujuan pengindeksan web. Sebuah crawler web juga dapat disebut spider web atau pengindeks otomatis.

Mesin pencari web dan beberapa situs lain menggunakan web crawling atau spidering software untuk memperbarui konten web mereka atau indeks konten web lain. Web crawler dapat menyalin semua halaman yang mereka kunjungi untuk diproses kemudian oleh sebuah mesin pencari yang meng-indeks halaman web sehingga pengunjung web dapat mencari mereka jauh lebih cepat. Crawler dapat memvalidasi hyperlink dan kode HTML, web crawler juga dapat digunakan untuk Scraping web.

Design Web Crawler Sederhana.

Pada artikel ini kita akan membuat sebuah web crawler sederhana untuk dapat menunjukkan dasar - dasar cara kerja web crawler dalam melakukan peng-indeksan halaman web. Dalam contoh yang akan disertakan tidak akan membahas masalah pengelolaan index, penjadwalan serta multi threading dalam crawling, artikel ini hanya mencakup fungsi dasar crawling saja.

Arsitektur web crawler yang akan kita implementasikan saat ini adalah sebagai berikut :



Design UI.

Sebelum mulai ke level code, mari kita membuat interface untuk web crawler kita, buatlah Tampilan seperti terlihat pada gambar dibawah ini 



Berikut Daftar Control dan keterangannya :

Jenis KomponenNamaText
FormForm1Form1
ButtonButton1Button1
TextBoxTextBox1
ListBoxListBox1

Deklarasi.

Setelah selesai dengan design UI, mari kita mulai membuat codenya, bukalah code designer dari Form1, kemudian ikuti imports item dan deklarasi seperti pada contoh berikut :


Imports System.Net
Imports System.IO
Imports System.Text.RegularExpressions

Public Class Form1

  Dim LinkCollection As New Collection
  Dim Depth As Integer = 5
  Private Const Regex_Href_Code As String = "href\s*=\s*(?:""(?[^""]*)""|(?\S+))"

End Class

Pada code diatas terlihat sebuah variable bernama Depth dengan nilai 5, variable ini berguna untuk membatasi kedalaman penelusuran link, karena pada contoh ini tidak menggunakan konsep multithread, maka pembatasan kedalaman penelusuran perlu dilakukan untuk mencegah komputer mengalami overload.

Pada code diatas terlihat pula variable bernama Regex_Href_Code, variable ini berguna untuk menyaring konten halaman yang mempunyai kriteria tertentu yang dapat dianggap sebagai sebuah link (URL).

Selanjutnya kita akan mulai membuat fungsi untuk web crawler kedalam form1.

Method ProcessLinkCollection.

Method ini akan digunakan untuk melakukan proses terhadap link - link yang diekstrak dari sebuah halaman web, berikut code nya :


Private Sub ProcessLinkCollection()
    Depth = -1
    For Each item In LinkCollection
      LinkCollection.Remove(item)
      ReadPageContent(item, TextBox1.Text)
      Application.DoEvents()
    Next
  End Sub

Method ExtractURL.

Method ini digunakan untuk melakukan pemeriksaan terhadap conten web dan mengekstrak link - link yang terdapat pada halaman tersebut dan menyimpannya dalam sebuah object collection, berikut code nya :

Function ExtractURL(Content As String, URL As String) As Collection
    Dim UrlCollection As New Collection
    Dim BaseURI As New Uri(URL)
    Dim HrefRegex As New Regex(Regex_Href_Code, RegexOptions.IgnoreCase Or RegexOptions.Compiled)
    Dim HrefMatch As Match = HrefRegex.Match(Content)
    Do While HrefMatch.Success = True
      Dim Link As String = HrefMatch.Groups(1).Value
      If Link.Substring(0, 1) <> "#" Then
        Dim Absolute As Boolean = False
        If Link.Length > 8 Then
          UrlCollection.Add(Link)
        End If
      End If
      HrefMatch = HrefMatch.NextMatch
    Loop
    Return UrlCollection
  End Function

Method ReadPageContent.

Method ini merupakan method utama yang berguna untuk melakukan web request dan membaca conten page serta menyimpan link - link yang terdapat pada halaman yang di-request, selanjutnya method ini akan menampilkan link - link yang cocok dengan kriteria pencarian, berikut codenya :

Sub ReadPageContent(URL As String, SearchedText As String)
    Dim BaseURI As New Uri(URL)
    Dim PageContent As String = String.Empty

    Try
      Dim PageRequest As HttpWebRequest = CType(WebRequest.Create(BaseURI), HttpWebRequest)
      Dim PageResponse As HttpWebResponse = PageRequest.GetResponse
      Dim PageReader As New StreamReader(PageResponse.GetResponseStream)

      PageContent = PageReader.ReadToEnd
      LinkCollection = ExtractURL(PageContent, URL)
      PageReader.Close()

      If PageContent.Contains(SearchedText) = True Then
        If Not ListBox1.Items.Contains(URL) Then ListBox1.Items.Add(URL)
        Application.DoEvents()
      End If

      For Each item In LinkCollection
        If Not ListBox1.Items.Contains(item) Then ListBox1.Items.Add(item)
        Application.DoEvents()
      Next

      If Depth > 0 Then
        ProcessLinkCollection()
      End If
    Catch ex As Exception

    End Try

  End Sub

Method Button1_Click.

Method ini adalah event triger untuk object button satu yang telah kita buat sebelumnya, berikut codenya :

Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
    ReadPageContent("https://www.google.com/search?q=" & TextBox1.Text, TextBox1.Text)
End Sub

Contoh web crawler sederhana ini dapat anda kembangkan untuk memproses link dan proses lainnya yang anda butuhkan, semoga bermanfaat.

Source: surya-pradhana