.:: Jasa Membuat Aplikasi Website,Desktop,Android Order Now..!! | | Order Now..!! Jasa Membuat Project Arduino,Robotic,Print 3D ::.

Cara Merubah hexadecimal to string pada vb6

0 komentar
 Berikut adalah cara merubah atau mengkonversi hexadecimal to string pada vb6

Public Function HexToStr(ByVal Data As String) As String
    Dim Buffer As String
    
        If Len(Data) Mod 2 <> 0 Then
            HexToStr = vbNullString
        Else
            For i = 1 To Len(Data) - 1 Step 2
                Buffer = Buffer & Chr("&H" & Mid(Data, i, 2))
            Next i
            HexToStr = Buffer
        End If
    End Function

atau kaya gini

Private Function HexToStr2(s As String) As String
Dim i As Integer
Dim dbl As Double
Dim iLen As Integer
Dim strReturn As String
Dim strHex As String

strReturn = ""
iLen = Len(s)
For i = 1 To iLen Step 2
dbl = Val("&H" & Mid(s, i, 2))
strHex = Chr(CLng(dbl))
strReturn = strReturn + strHex
Next i
HexToStr2 = strReturn
End Function


ngegunain fungsi nya
Text1.Text = HexToStr(Text2.Text)
Text1.Text = HexToStr2(Text2.Text)


download project nya di mari:
http://www.4shared.com/rar/uFpZQyP-ce/hexatostring.html
Suni

Solved Error Warning: Cannot modify header information - headers already sent by

0 komentar
Cara mengatasi permasalahan tersebut adalah
letakan code berikut diatas
<?php ob_start(); ?>

for example
<?php ob_start();?>
<html>


terus
letakan code <?phpob_flush();?>

for example
</html>
<?phpob_flush();?>

pastikan tidak ada spasi sebelum code <?php
Suni

Cara Memperbaiki Damaged SD Card Di HP Android

0 komentar
Cara Memperbaiki Damaged SD Card Di HP Android - Sering sekali memory card pada Hp Android mengalami Damaged SD Card , yang mana Memory tersebut minta di format , tapi jangan kuatir berikut adalah cara memperbaiki memory card tanpa harus di format terlebih dahulu .

Siapkan satu buah cardrider atau sejenis nya , lalu masukan card rider + memory nya ke laptop atau komputer





setelah itu buka cmd(pencet logo windows + r lalu ketik cmd lalu ok)
lalu ketik chkdsk /x /f  h:                    *h sesuaikan dengan letak sd card anda

Tunggu sampai selesai seperti gambar diatas ,
*ketika pas error atau gagal di tengah2 pencet try again terus sampai gk error

Selesai
Berikut adalah cara memperbaiki memory card yang minta di format



Suni

Aplikasi E-Learning Menggunakan PHP dan MySQL

0 komentar
Salam sejahtera buat saudara semua yang bekenan singgah dihalaman blogger saya. kedatangan anda tentu memiliki keinginan untuk mendapatkan sesutu yang anda harap pada sebuah halaman blog.....
untuk anda yang mengakses blog saya disini tersedia berbagai jenis aplikasi serderhana bahkan aplikasi yang lumayan untuk dikembangkan menjadi sebuah aplikasi yang memiliki harga jual.

pada halaman ini saya membagikan sebuah aplikasi yang dibuat dengan bahasa pemrograman PHP dan database MySQl yaitu aplikasi E-learning. apilikasi E-learning memiliki counten antar muka user sebagai pengguna dan admin sebagai pelaku manajemn data. user merupakan pihak yang mengikuti pembelajaran learning dengan proses pendaftaran terlebih dahulu untuk mendapatkan user name dan password agar bisa mengikuti pembelajaran e-learning. bentuk tampilan dari aplikasi e-learning dapat dilihat pada gambar dibawah ini.

bagi kawan-kawan yang ingin mendapatkan souce kode aplikasi E-learning ini dapat di download pada link di bawah ini.

Download Souce Kode E-Learning

jika ada maslah saat menjalakan aplikasi ini silahkan tingalkan komentar anda.

Suni

Contoh Sederhana Pemrograman serial port vb6

0 komentar
Contoh Sederhana Pemrograman serial port vb6
Contoh Sederhana Pemrograman serial port vb6

kali kita akan membahas pemrograma serial yang pertama harus di siapkan adalah virtual serial port nya anda bisa download di sini http://www.eterlogic.com/downloads/SetupVSPE.zip

setelah download silahkan add device serial port nya , terserah mau com1 , com2 ,dst

Codingan pada form kirim serial sebagai berikut

Private Sub Command1_Click()
    MSComm1.Output = Text1.Text
   
    End Sub

Private Sub Form_Load()
    MSComm1.CommPort = 3        'tergantung COM port yang tersedia
    MSComm1.Settings = "9600,N,8,1" 'contoh setting serial port
    MSComm1.InputLen = 0
    MSComm1.RThreshold = 1
    MSComm1.PortOpen = True
          
  
  
End Sub

Private Sub Form_Unload(Cancel As Integer)
    MSComm1.PortOpen = False
End Sub

Private Sub MSComm1_OnComm()

Select Case MSComm1.CommEvent
   ' Errors
      Case comEventRxParity   ' Parity Error.
         MsgBox "Parity"
              
   ' Events
      Case comEvReceive ' Received RThreshold # of chars.
         Text2.Text = MSComm1.Input
End Select

End Sub


Codingan pada form menerima serial sebagai berikut



Private Sub Form_Load()
    MSComm1.CommPort = 3        'tergantung COM port yang tersedia
    MSComm1.Settings = "9600,N,8,1" 'contoh setting serial port
    MSComm1.InputLen = 0
    MSComm1.RThreshold = 1
    MSComm1.PortOpen = True
    Form2.Show
   
End Sub

Private Sub Form_Unload(Cancel As Integer)
    MSComm1.PortOpen = False
End Sub

Private Sub MSComm1_OnComm()
Select Case MSComm1.CommEvent
   ' Errors
     Case comEventRxParity   ' Parity Error.
         MsgBox "Parity"
              
  '  Events
      Case comEvReceive ' Received RThreshold # of chars.
         Text1.Text = MSComm1.Input
End Select

End Sub

sekian
anda bisa mendownload prjoect nya disini :
http://www.4shared.com/rar/7GNC_IwKce/serial_port_upload.html
Suni

Pemrograman Serial Port Pada VB6

0 komentar
Berikut teori sedikit tentang pemrograman serial port pada vb6

Untuk pengaksesan port serial kita dapat mengaksesnya secara langsung menggunakan kontrol MSComm(microsoft comm control 6.0)  yang telah disediakan Visual basic.

Kontrol MSComm menyediakan fisilitas komunikasi antara program aplikasi yang kita buat dengan port serial untuk mengirim atau menerima data melalui port serial.

Setiap MSComm hanya menangani satu port serial sehingga jika kita ingin menggunakan lebih dari satu port serial harus digunakan MSComm lain.

CommPort
Digunakan untuk menentukan nomor port serial yang akan dipakai
contoh nya MSComm1.CommPort = 3
maka port serial yang di gunakan adalah COM3


Setting
Digunakan untuk menset nilai baud rate, pariti, jumlah bit data, dan jumlah bit stop.
Contoh nya MSComm1.Settings = "9600,N,8,1"
Setting MSComm nya adalah Baud Rate 9600, Tanpa Paritas, Jumlah data 8bit, dan jumlah bit stop 1 bit.

PortOpen
Digunakan untuk membuka ataupun menutup port serial yang dihubungkan dengan MSComm ini
Contoh nya :   MSComm1.PortOpen = True
Kalo true port kebuka , kalo false ketutup

Input
Digunakan untuk mengambil data string yang ada pada buffer penerima.


Output
Digunakan untuk menulis data string pada buffer kirim



MSComm hanya mempunyai satu even saja, yaitu even OnComm.
Even OnComm dibangkitkan jika nilai properti dari CommEvent berubah yang mengindikasikan telah terjadi even pada port serial baik even komunikasi maupun even error.









Tabel berikut adalah tabel mengenai nilai � nilai dari properti CommEvent, nilai properti ini tidak  tersedia pada saat design time, tetapi hanya dapat dibaca pada saat run time.

Nilai-nilai properti even error pada CommEvent

KONSTANTA                               KETERANGAN
ComEventFrame                             Hardware mendeteksi adanya keselahan frame
ComEventRxParity                         Hardware Mendeteksi adanya kesalahn parity
ComEventRxOver                          Buffer penerima mengalami over flow, tidak ada lagi ruang kosong '                                                       untuk penerima
ComEventTxfull                             Buffer kirim penuh
ComEventOverRun                         Port mengalami over run
ComEventBreak                             Sinyal Break diterima
ComEventDCB                               Mendapatkan Kembali Device Control block dari port serial
comEvSend                                     Jumlah karater yang dikirim lebih sedikit dari pada nilai property  '                                                       sthreshold, even ini akan di bangkitkan jika nilai pada property '                                                       sthreshold tidak di isi "0"
 comEvReceive                              Telah diterima karakter sebanyak nilai property rthreshold , even '                                                       ini akan dibangkitan terus menerus sampai data diambil dari buffer '                                                       penerima menggunakan perintah input event ini akan dibangkitkan '                                                       jika nilai pada rthersold tidak diisi atau 0
comEvCTS                                     Terjadi Perubahan pada saluran Clear To Send
comEvDSR                                     Terjadi Perubahan pada saluran Data Set Ready
comEvCD                                       Terjadi Perubahan pada saluran Carrier Detect
comEvRing                                     Terdetksi ada nya sinyal ring
comEvEOF                                     Karakter End Of FIle Diterima



Setting Receive and Transmit Buffer Properties

Ada beberapa property dari receive buffer dan transmit buffer (property dari MS Comm) yang perlu kita atur.

    InBufferSize : mengatur ukuran receive buffer
    OutBufferSize : mengatur ukuran transmit buffer
    Rthreshold : menentukan jumlah karakter yang diterima oleh receive buffer sebelum OnComm event dipicu
    Sthreshold : menentukan jumlah karakter yang diterima oleh transmit buffer sebelum OnComm event dipicu
        Jika bernilai 0 berarti tidak pernah dipicu
        Jika bernilai 1 berarti dipicu setiap satu karakter
    InputLen : menentukan jumlah karakter yang dibaca CPU dari receive buffer
        Jika bernilai � 0 �, maka seluruh isi receive buffer akan dibaca CPU
    InputMode : menentukan tipe data input yang akan dibaca CPU
        comInputModeText : untuk data string/teks
        comInputModeBinary : untuk data biner



Sekian
Contoh sederhana serial port
http://www.taufikismail.web.id/2014/09/contoh-sederhana-pemrograman-serial-port-vb6.html


Suni

Cara Menampilkan Data Dari Database Di Listview VB.NET

0 komentar
Berikut adalah Cara Menampilkan Data Dari Database Di Listview VB.NET dengan menggunakan visual studio 2010

taro di tombol
call carilistitem

  Sub carilistiem()
        Call opendb()
        '   Dim zz2 As String
        Dim nn22 As Integer = 0
        For nn22 = 0 To Me.lvtele.Items.Count - 1

            Dim xkodecm2 = lvtele.Items(nn22).Text
           ' Dim xreport2 = lvtele.Items(nn22).SubItems(6).Text
            Dim cc As String
            cc = " select * from calonmahasiswa where kdcalonmahasiswa = '" & xkodecm2 & "' "
            cmd = New OleDb.OleDbCommand(cc, conn)
            Dim rs As OleDb.OleDbDataReader
            rs = cmd.ExecuteReader
            If rs.Read Then
                lvtele.Items(nn22).SubItems(1).Text = rs("namacalonmahasiswa")
                lvtele.Items(nn22).SubItems(2).Text = rs("alamat")
                lvtele.Items(nn22).SubItems(3).Text = rs("nohp")
                lvtele.Items(nn22).SubItems(4).Text = rs("kdsekolah")
                lvtele.Items(nn22).SubItems(6).Text = rs("report")
           
            End If

           
        Next

    End Sub







*lvtele nama listview nya
 
Suni

Cara Sortir Data Pada Listview VB.NET

0 komentar
Berikut adalah cara untuk menyortir data yang ada di dalam column vb.net

pertama tambahkan module
lalu masukan codingan berikut :


Public Class ListviewComparer
    Implements IComparer

    Private mColumnNumber As Integer
    Private mSortOrder As SortOrder

    Public Sub New(ByVal ColumnNumber As Integer, ByVal SortOrder As SortOrder)
        mColumnNumber = ColumnNumber
        mSortOrder = SortOrder
    End Sub
    Public Function Compare(ByVal x As Object, ByVal y As Object) As Integer Implements IComparer.Compare
        Dim itemX As ListViewItem = DirectCast(x, ListViewItem)
        Dim itemY As ListViewItem = DirectCast(y, ListViewItem)

        Dim stringX As String
        If itemX.SubItems.Count <= mColumnNumber Then
            stringX = ""
        Else
            stringX = itemX.SubItems(mColumnNumber).Text
        End If

        Dim stringY As String
        If itemY.SubItems.Count <= mColumnNumber Then
            stringY = ""
        Else
            stringY = itemY.SubItems(mColumnNumber).Text
        End If

        If mSortOrder = SortOrder.Ascending Then
            If IsNumeric(stringX) And IsNumeric(stringY) Then
                Return Val(stringX).CompareTo(Val(stringY))
            ElseIf IsDate(stringX) And IsDate(stringY) Then
                Return DateTime.Parse(stringX).CompareTo(DateTime.Parse(stringY))
            Else
                Return String.Compare(stringX, stringY)
            End If
        Else
            If IsNumeric(stringX) And IsNumeric(stringY) Then
                Return Val(stringY).CompareTo(Val(stringX))
            ElseIf IsDate(stringX) And IsDate(stringY) Then
                Return DateTime.Parse(stringY).CompareTo(DateTime.Parse(stringX))
            Else
                Return String.Compare(stringY, stringX)
            End If
        End If
    End Function

End Class


setelah itu tambahan codingan berikut di dalam form yang ada listview nya
Private mSortingColumn As ColumnHeader


Setelah itu taro codingan di lvcolumn click Contoh nya berikut 

 Private Sub ListView1_ColumnClick(ByVal sender As Object, ByVal e As System.Windows.Forms.ColumnClickEventArgs) Handles ListView1.ColumnClick

        'mendekralariskan variable NewSortingColumn
        Dim NewSortingColumn As ColumnHeader = ListView1.Columns(e.Column)
        'mendeklarasikan variable SortOrder
        Dim SortOrder As SortOrder

        'jika variable mSortingColumn kosong
        If mSortingColumn Is Nothing Then
            'mengisi variable sortorder sebagai ascending
            SortOrder = Windows.Forms.SortOrder.Ascending
        Else
            'mengecek apakah column yang diklik itu sama dengan column yang sebelumnya
            If NewSortingColumn.Equals(mSortingColumn) Then
                'jika column text dimulai dengan tanda ^ maka
                If mSortingColumn.Text.StartsWith("^ ") Then
                    'mengisi variable sortorder sebagai descending
                    SortOrder = Windows.Forms.SortOrder.Descending
                Else
                    'mengisi variable sortorder sebagai ascending
                    SortOrder = Windows.Forms.SortOrder.Ascending
                End If
            Else
                'mengisi variable SortOrder sebagai ascending
                SortOrder = Windows.Forms.SortOrder.Ascending
            End If

            mSortingColumn.Text = mSortingColumn.Text.Substring(2)
        End If

        mSortingColumn = NewSortingColumn
        'jika SortOrder = Ascending
        If SortOrder = Windows.Forms.SortOrder.Ascending Then
            mSortingColumn.Text = "^ " & mSortingColumn.Text
        Else
            mSortingColumn.Text = "? " & mSortingColumn.Text
        End If

        ListView1.ListViewItemSorter = New ListviewComparer(e.Column, SortOrder)

        ListView1.Sort()


    End Sub


Selesai....
tinggal klik header column nya maka data akan ke sortir

Silahkan download project nya disini :
http://www.4shared.com/rar/Rphj3QPIba/sortirlistview.html
 


Suni

Cara Stretch Gambar Background dengan html css

0 komentar
 berikut adalah codingan agar gambar yang menjadi background menjadi layar full
<!DOCTYPE html>
<html>
<style typpe ="text/css">
#bg{
position : fixed;
top:0;
left:0;
width: 100%;
height:100%;
}
</style>
<body >
<img src="BACKGROUND-WEB.jpg" alt="gambar" id="bg"/>
</body>
</html>
Suni

Cara Isi ComboBox sesuai data di Database VB.NET

0 komentar
berikut codingan agar isi combobox diambil dari data yang ada di database
taro di form_load

Call opendb()

        Dim AA As String = " SELECT * FROM petugas"
        cmd = New OleDb.OleDbCommand(AA, conn)
        Dim RS As OleDb.OleDbDataReader
        RS = cmd.ExecuteReader()
        cmbidpetugas.Items.Clear()
        If RS.HasRows Then
            While RS.Read
                cmbidpetugas.Items.Add(RS("idpetugas"))
            End While
        End If
Suni

Cara Menghitung Total Jumlah di column Listview VB.Net

0 komentar


 contoh berikut adalah menghitung total harga dari subtotal yang ada di column listviwq pemesanan makan.
berikut codingan nya , silahkan taro di tombol hitung atau bebas
Dim xjmlhrg As Integer
        Dim MM As Integer = 0

        For MM = 0 To Me.lvpesen.Items.Count - 1

            xjmlhrg = xjmlhrg + Val(lvpesen.Items(MM).SubItems(4).Text)
        Next

        'Txttotalharga.Text = Format(xjmlhrg, "#,##0") 




        txttotalharga.Text = xjmlhrg
Suni

Cara Menyimpan Data Di Listview VB.NET

0 komentar
 Berikut saya ada cara atau codingan untuk menyimpan data di listview vb.net

simpan listview vb.net
simpan listview vb.net
   Private Sub cmdsave_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdsave.Click
call opendb()
Dim xKODE As String = ""
            Dim xNAMA As String = ""
            Dim xHARGA As Double = 0
            Dim xJUMLAH As Double = 0
            Dim xSUBTOTAL As Double = 0

            Dim MM As Integer = 0
            For MM = 0 To Me.lvpesen.Items.Count - 1
'lvpesen nama listview nya

                xKODE = lvpesen.Items(MM).Text
                xNAMA = lvpesen.Items(MM).SubItems(1).Text
                xHARGA = lvpesen.Items(MM).SubItems(2).Text
                xJUMLAH = lvpesen.Items(MM).SubItems(3).Text
                xSUBTOTAL = lvpesen.Items(MM).SubItems(4).Text

                Dim KK As String = ""
                KK = " INSERT INTO dpesenmakan " & _
                    "(no_pesen " & _
                " ,nama_makanan " & _
                " ,harga " & _
                " ,jumlah " & _
                " ,kode_makanan " & _
                " ,subtotal)" & _
                " VALUES " & _
                " ('" & txtnopesen.Text & "' " & _
                " ,'" & xNAMA & "' " & _
                " ,'" & xHARGA & "' " & _
                " ,'" & xJUMLAH & "' " & _
                " ,'" & xKODE & "' " & _
                " ,'" & xSUBTOTAL & "') "
                cmd = New OleDb.OleDbCommand(KK, conn)
                cmd.ExecuteNonQuery()
                cmd.Dispose()
            Next
end sub
Suni

Pin Dan Nama Serial Port

0 komentar
Pin #
Mnemonic
Full name
1
CD
Carrier Detect
2
RCD
Receive Data
3
TXD
Transmit Data
4
DTR
Data Terminal Ready
5
GND
Ground
6
DSR
Data Set Ready
7
RTS
Request To Send
8
CTS
Clear To Send
9
RI
Ring Indicator

9 Pin Connector on a DTE device (PC connection)
Male RS232 DB9 9 PIN
Pin Number Direction of signal:
1 Carrier Detect (CD) (from DCE) Incoming signal from a modem
2 Received Data (RD) Incoming Data from a DCE
3 Transmitted Data (TD) Outgoing Data to a DCE
4 Data Terminal Ready (DTR) Outgoing handshaking signal
5 Signal Ground Common reference voltage
6 Data Set Ready (DSR) Incoming handshaking signal
7 Request To Send (RTS) Outgoing flow control signal
8 Clear To Send (CTS) Incoming flow control signal
9 Ring Indicator (RI) (from DCE) Incoming signal from a modem
Suni

Menampilkan Form sesuai Pilihan Radiobutton dengan PHP

0 komentar
Menampilkan Form sesuai dengan Pilihan radiobutton dengan php..
Sedikit saya jelaskan maksud dari judul di atas, misalkan saudara sekalian ingin membuat beberapa radiobutton yang setiap radiobuttonnya berfungsi untuk menampilkan form atau apa pun. contoh : saudara sekalian membuat 4 radiobutton, yaitu radiobutton1, radiobutton2, radiobutton3, radiobutton4, dan saudara ingin Jika radiobutton 1 di pilih maka akan tampil form 1, dan seterusnya . jika belum mengerti ni saya kasih gambarnya ..


Nah tu dia tu Penampakannya..
jika di klik form 1 radiobutton, maka yang tampil di sebelahnya form 1..
demikianlah penjelasanya.

nah untuk tahap membuat itu semua kita harus mengcopy paste script di bawah ini :
cekidot .

untuk form utama dulu ya..
1. buat file dengan nama form.php
 pastekan script berikut di dalamnya.

<table border="1" width="100%">
<tr valign="top">
<td>  <input type="radio"  name="Miez" value="form1"  onclick="document.getElementById('Miez').src='form1.php'"/>FORM 1
<br /><input type="radio" name="Miez" value="form2" onclick="document.getElementById('Miez').src='form2.php'"/>FORM 2
<br /><input type="radio" name="Miez" value="form3" onclick="document.getElementById('Miez').src='form3.php'"/>  FORM 3
<br /><input type="button" value="Cek" onclick="document.getElementById('Miez').src='form4.php'">
<td>
<iframe name="out" style="display:nne" id="Miez" src="" width="100%" height="100%"></iframe>
</table>

2. buat file dengan nama form1.php

paste kan ini :  This Form 1.

untuk yang selanjutnya juga sama caranya buat form2.php buat aja form sesuai dengan keinginan anda.

yang terpenting dari hal di atas adalah di dalam input type ada name=Miez ..Itu adalah kunci dari semua script di atas. jika anda ingin merubahnya jangan lupa untuk merubah tulisan Miez Tersebut.

demikianlah. 
semoga berhasil.
Suni

Membuat Chat Client Server dengan winsock vb6

0 komentar
Chat Clien Server



Pertama tambahkan dulu miscosoft winsock control 6.0 dengan cara CTRL + T atau project > component
berikut adalah sedikit contoh codingan chat client server dengan menggunakan winsock pada vb6

 FORM CLIENT NYA

Dim waktu As Integer
Dim sck As String




Private Sub cmdcekkoneksi_Click()

If Winsock1.State = sckConnected Then
MsgBox "konek"
Else
MsgBox "tidak konek"
Exit Sub
End If
End Sub

Private Sub cmdkoneksi_Click()
'jika server belom listening atau belom siap menerima koneksi
If sckListening = False Then
 Text2.Text = Text2.Text & "Gagal Terhubung" & vbCrLf
Exit Sub
'Else

End If
'state 7 berarti sudah terkoneksi dengan server
If Winsock1.State = 7 Then
   Exit Sub
    Winsock1.Close
    'state 9 error maka harus di tutup kembali
ElseIf Winsock1.State = 9 Then
   Winsock1.Close

End If
'state 8 berarti sudah terhubung tapi server terputus sehingga state mengambang
If Winsock1.State = 8 Then
    Winsock1.Close
    ElseIf Winsock1.State = 9 Then
   Winsock1.Close
 '  ElseIf Winsock1.State = 6 Then
  ' Winsock1.Close
End If

Winsock1.RemoteHost = "192.168.1.144"  'ip server
'Winsock1.RemoteHost = "192.168.43.202"
Winsock1.RemotePort = 1001
Winsock1.Connect

End Sub





Private Sub cmdsend_Click()

If Not Winsock1.State = 7 Then
Text2.Text = Text2.Text & "Tidak Terhubung Ke Server" & vbCrLf
Exit Sub
End If

Winsock1.SendData Me.Text1.Text
DoEvents
Text2.Text = Text2.Text & vbCrLf & "Client :" & Me.Text1.Text
Text1.Text = ""

End Sub


Private Sub Form_Load()
'main
'Label2.Caption = winsock1.LocalIP
Label2.Caption = "192.168.1.136"
'winsock1.RemoteHost = "192.168.1.144"

'status atau keadaan winsock
txtstate.Text = Winsock1.State

Timer1.Enabled = True


End Sub





Private Sub Timer1_Timer()
'If Winsock1.State = 8 Then
'Winsock1.Close
'End If

'If Not Winsock1.State = sckListening Then
      
 '       Else
' Text2.Text = Text2.Text & "Try to Connect" & vbCrLf
           
  'End If
sck = txtstate.Text
If sck <> Winsock1.State Then
  If Winsock1.State = 0 Then
        Text2.Text = Text2.Text & "Tidak Terhubung/Client Terputus" & vbCrLf
      '  Timer1.Enabled = False
    ElseIf Winsock1.State = 6 Then
    'Timer1.Enabled = False
        Text2.Text = Text2.Text & "Connecting" & vbCrLf
        'Timer1.Enabled = False
    ElseIf Winsock1.State = 7 Then
        Text2.Text = Text2.Text & "Terhubung" & vbCrLf
     '   Timer1.Enabled = False
    ElseIf Winsock1.State = 8 Then
        Text2.Text = Text2.Text & "Terputus Dari server" & vbCrLf
      '  Timer1.Enabled = False
    ElseIf Winsock1.State = 9 Then
        Text2.Text = Text2.Text & "Gagal Terhubung" & vbCrLf
       ' Timer1.Enabled = False
    End If
 End If

If Winsock1.State = 7 Then
Image1.Visible = False
Image2.Visible = True

Else
Image1.Visible = True
Image2.Visible = False
End If
txtstate.Text = Winsock1.State

End Sub



Private Sub winsock1_DataArrival(ByVal bytesTotal As Long)
Dim strdata As String
Winsock1.GetData strdata

Text2.Text = Text2.Text & vbCrLf & "Server :" & strdata
Text2.SelStart = Len(Text2.Text)

End Sub

Private Sub winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
'MsgBox "Error : " & Description
'Winsock1.Close

End Sub





Private Sub winsock1_DataArrival(ByVal bytesTotal As Long)
Dim strdata As String
Winsock1.GetData strdata

Text2.Text = Text2.Text & vbCrLf & "Server :" & strdata
Text2.SelStart = Len(Text2.Text)

End Sub

Private Sub winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
'MsgBox "Error : " & Description
'Winsock1.Close

End Sub

FORM SERVER NYA


Option Explicit

Private Sub cmdlisten_Click()
Timer1.Enabled = True
Winsock1.Close
 Winsock1.LocalPort = 1001
   Winsock1.Listen
'Winsock1.Connect

End Sub

Private Sub cmdsend_Click()
Winsock1.SendData Text1.Text
DoEvents

Text2.Text = Text2.Text & vbCrLf & "Server : " & Text1.Text
Text1.Text = ""

End Sub

Private Sub cmdstop_Click()
Timer1.Enabled = True
'Do Until Winsock1.State = 0
Winsock1.Close
'Loop
End Sub

Private Sub Form_Load()
main
Winsock1.LocalPort = 1001
Winsock1.Listen
Timer1.Enabled = True

End Sub

Private Sub Timer1_Timer()
'If Winsock1.State <> 7 Then
 ' Winsock1.Close
  'Winsock1.Listen
  'End If
  'Dim tempsck As String
'tempsck = txtstate.Text

'If tempsck <> Winsock1.State Then
'If Winsock1.State = 8 Then
 '   Winsock1.Close
  '  Text2.Text = Text2.Text & "Clien Terputus" & vbCrLf
   ' Winsock1.Listen
'   Text2.Text = Text2.Text & "Server Restart" & vbCrLf
'ElseIf Winsock1.State = 7 Then
 '   Text2.Text = Text2.Text & "Terhubung Dengan Klien" & vbCrLf
'Timer1.Enabled = False
'ElseIf Winsock1.State = 2 Then
 '   Text2.Text = Text2.Text & "Server Aktif" & vbCrLf
'Timer1.Enabled = False
'ElseIf Winsock1.State = 7 Then
 '   Text2.Text = Text2.Text & "Terhubung Dengan Klien" & vbCrLf
'Timer1.Enabled = False
'ElseIf Winsock1.State = 0 Then
 '   Text2.Text = Text2.Text & "Server Tidak Aktif" & vbCrLf
'Timer1.Enabled = False
'End If
'End If
If Winsock1.State = 0 Then
Image1.Visible = True
Image2.Visible = False
Else
Image1.Visible = False
Image2.Visible = True
End If


  txtstate.Text = Winsock1.State
 
End Sub

Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
 If Winsock1.State <> sckClosed Then
        Winsock1.Close
    End If
Winsock1.Accept requestID
 Text2.Text = Text2.Text & _
        "Accepted connection from: " & _
        Winsock1.RemoteHostIP & vbCrLf
End Sub

Private Sub winsock1_DataArrival(ByVal bytesTotal As Long)
Dim strdata As String
Winsock1.GetData strdata

Text2.Text = Text2.Text & vbCrLf & "Client : " & strdata
Text2.SelStart = Len(Text2.Text)

End Sub



Jika masih belom jelas maka bisa download project nya di sini
http://www.4shared.com/rar/QYBuVN8Wce/chat_vb__1_.html
Suni

Cara Menghitung jumlah karater atau kata pada vb6

0 komentar
Public Function GetWordCount(ByVal Text As String) As Long
              'Definisikan sebuah tanda hubung pada setiap akhir baris yang
              'merupakan bagian dari seluruh kata, jadi kombinasikan bersama.
              Text = Trim(Replace(Text, "-" & vbNewLine, ""))
              'Ganti baris baru dengan sebuah space tunggal

              Text = Trim(Replace(Text, vbNewLine, " "))
              'Ganti spasi yang lebih dari satu (jika ada) menjadi spasi tunggal
              Do While Text Like "*  *"
                  Text = Replace(Text, "  ", " ")

              Loop
              'Pisahkan string dan kembalikan kata yang dihitung
              GetWordCount = 1 + UBound(Split(Text, " "))
          End Function
Private Sub Command2_Click()

Text2 = GetWordCount(Text1.Text)
End Sub
Suni

Membuat file txt di vb6

0 komentar
membuat file txt pada vb 6
Private Sub cmdcreate_log_Click()
 Dim pathh As String

'open "C:\Users\TAUFIK\Downloads\Compressed\ada\tesasast.txt", Text2.Text
Dim ff As Integer
ff = FreeFile()
Dim tanggal As String
Dim hari As String
Dim bulan As String
Dim tahun As String
 tahun = Format(Now, "yyyy")
 bulan = Format(Now, "mm")
 hari = Format(Now, "dd")
 tanggal = tahun + bulan + hari
pathh = "F:\Ilmu\chat vb\filenya\"
   Dim aaa As String
   aaa = tanggal + ".txt"

Open pathh & aaa For Append As #ff
Write #ff, Text2.Text
Close #ff
End Sub


cara open file txtnya
Private Function GetFileContents(ByVal file_name As String) As String
Dim fnum As Integer

    ' Open the file.
    fnum = FreeFile
    Open file_name For Input As fnum

    ' Grab the file's contents.
    GetFileContents = Input(LOF(fnum), fnum)

    ' Close the file.
    Close fnum
End Function

Private Sub cmdLoad_Click()
    txtFile.Text = GetFileContents(txtFilename.Text)
End Sub

*txtfile = tempat isi content nya
*txtfilename = tempat path nya

cara ngeclear file nya
 Open pathh & aaa For Output As #ff
Close #ff
Suni

Tawk.to