Manfaatkan pasang iklan di Pasang Iklan, sekali isi form langsung bisa di submit ke banyak website. Buruan mumpung masih gratis klik di sini Pembuatan Website Company Profil, Katalog Produk, Web Iklan Baris, Perumahan / Real Estate, Furniture dll. hub : sanricoster@gmail.com atau telp: 62 - 88 215 097 034

Menampilkan data saat Grid di double klik Private Sub Grid_DblClick() If Grid.TextMatrix(Grid.Row, 1) = "" Then Exit Sub MsgBox Grid.TextMatrix(Grid.Row, 1) End Sub Guard.asp <% '--------------------------------------------------------------------------- ' memisah-misahkan koma... One Hour Time for this... Discovery ' tag OPTION butuh skrip ini!!!! 'dim idArray() '--------------> variable inti hasil dari fungsi sub pisah( idelete, idCount, idArray() ) '--------------> isi [idel] dengan nama OPTION c = 1 w = 1 if idelete = "" then exit sub redim preserve idArray(idCount) idelete=idelete + "," for i = 1 to idCount c = instr( mid(idelete, w), "," ) 'response.write "<b>" & mid(idelete, w, c-1) & "<br></b>" idArray(i) = trim(mid(idelete, w, c-1)) w = w+c next end sub %> <% '-------------------------------------------------------------- ' Prevent tag from INTRUDER!!!! '-------------------------------------------------------------- function GuardTag( s ) st = "" endTag = "" startAnchor = false for i = 1 to len(s) tmp = mid(s, i, 1) '---------- PREVENT ALL TAGS if tmp = "<" then tmp = "&lt" if tmp = ">" then tmp = "&gt" if tmp = "'" then tmp = """" if tmp = chr(13) then tmp = "<br>" if i > 2 then tmpA = mid(s, i-1, 1) tmpB = mid(s, i-2, 1) end if if i+2 <= len(s) then tmp1 = mid(s, i+1, 1) tmp2 = mid(s, i+2, 1) end if '--------- ALLOWING BOLD TAG if tmp = "[" AND ucase(tmp1)="B" AND tmp2="]" then tmp = "<" if tmp = "]" AND ucase(tmpA)="B" AND tmpB="[" then tmp = ">" endTag = "B" end if if endTag <> "" AND (tmp = "[" AND ucase(tmp1)="/" AND tmp2="]") then tmp ="<" if endTag <> "" AND (tmp = "]" AND ucase(tmpA)="/" AND tmpB="[") then tmp = endTag & ">" endTag = "" end if '--------- ALLOWING ANCHOR TAG if tmp = "[" AND ucase(tmp1)="A" AND tmp2=":" then tmp = "<" startAnchor = true end if if tmp = ":" AND ucase(tmpA)="A" AND tmpB="[" then tmp = " href=" endTag = "A" end if if startAnchor = true AND tmp = "]" then startAnchor = false tmp = ">" end if if endTag <> "" AND (tmp = "[" AND ucase(tmp1)="/" AND tmp2="]") then tmp ="<" if endTag <> "" AND (tmp = "]" AND ucase(tmpA)="/" AND tmpB="[") then tmp = endTag & ">" endTag = "" end if st = st + tmp next GuardTag = st end function function UnGuardTag( s ) st = "" UnGuardTag = "" notLen = 0 isAnchor = false if isnull(s) then exit function DoNot = false j = 0 for i = 1 to len(s) tmp1 = mid(s, i, 1) tmp2 = mid(s, i, 4) tmp3 = mid(s, i, 8) tmp4 = mid(s, i, 3) if isAnchor AND tmp1=">" then st = st + "]" DoNot = true notLen = 0 isAnchor=false elseif tmp2 = "<br>" then st = st + chr(13) DoNot = true notLen = 3 elseif tmp2 = "</A>" or tmp2 = "</B>" then st = st + "[/]" DoNot = true notLen = 3 elseif tmp4 = "<b>" then st = st + "[b]" DoNot = true notLen = 2 elseif tmp3 = "<a href=" or tmp3 = "<A href=" then isAnchor = true st = st + "[a:" DoNot = true notLen = 7 end if if DoNot then ' do not write the tags! while length is exeeds j = j + 1 if j > notLen then DoNot = false else ' now write the tags! j = 0 st = st + tmp1' + tmp tmp = "" end if next UnGuardTag = st end function '-------------------------------------------------------------- '-------------------------------------------------------------- ' Prevent email error writing '-------------------------------------------------------------- Sub CreateFolder( strPath ) ' response.Write(strPath) Dim fso, fldr Set fso = CreateObject("Scripting.FileSystemObject") if not fso.FolderExists(strPath) Then Set fldr = fso.CreateFolder(strPath) end if set fso = Nothing End Sub Sub DeleteFolder( strPath ) dim fso, folderObject, errCounter Set fso = CreateObject("Scripting.FileSystemObject") if fso.FolderExists(strPath) Then Set folderObject = fso.GetFolder(strPath) ' errCounter = 0 ' on error resume next ' while (err.number <> 0) OR (errCounter < 3) ' err.clear folderObject.Delete ' errCounter = errCounter + 1 ' wend end if Set folderObject = Nothing Set fso = Nothing end sub Sub DeleteFile( strFile ) dim errCounter Set fso = CreateObject("Scripting.FileSystemObject") if fso.FileExists(strFile) then Set fileObject = fso.GetFile(strFile) ' errCounter = 0 ' on error resume next ' while (err.number <> 0) OR (errCounter < 3) ' err.clear fileObject.Delete ' errCounter = errCounter + 1 ' wend end if Set fileObject = Nothing Set fso = Nothing end Sub function FormatUang( u ) n=len(u) if (n>3 and n<=6) then p=right(u,3) c=mid(u,1,n-3) FormatUang=c & "." & p elseif (n>6 and n<=9) then r=right(u,3) p=right(u,6) c=mid(p,1,3) c=c & "." & r p=mid(u,1,n-6) FormatUang=p & "." & c else FormatUang=u end if end function '-------------------------------------------------------------- '---- JIKA string kepanjangen maka potong ganti ... function FitString(s, n) if len(s) > n then FitString = left(s, n-3) & "..." else FitString = s end if end function %> ListView Private Sub ListView1_DblClick() If ListView1.ListItems.Count <= 0 Then Exit Sub With ListView1.ListItems(ListView1.SelectedItem.Index) Text1.Text = .Text Text2.Caption = .SubItems(1) Text3.Text = .SubItems(2) End With End Sub Sub TampilkanData() Dim conn As New ADODB.Connection Dim rs As New ADODB.Recordset Dim SQL As String SQL = "Provider=SQLOLEDB.1;Persist Security Info=True;Password=123; User ID=sa;Initial Catalog=database;Data Source=." conn.Open SQL rs.Open "select * from barang", conn ListView1.ListItems.Clear While Not rs.EOF Set listX = ListView1.ListItems.Add(, , rs!Nama) rs.MoveNext Wend rs.Close conn.Close End Sub Print Struk Silahkan source code berikut ini: ' ---------------- ' ---------------- Option Explicit Private Type DOCINFO pDocName As String pOutputFile As String pDatatype As String End Type Private Declare Function ClosePrinter Lib "winspool.drv" (ByVal hPrinter As Long) As Long Private Declare Function EndDocPrinter Lib "winspool.drv" (ByVal hPrinter As Long) As Long Private Declare Function EndPagePrinter Lib "winspool.drv" (ByVal hPrinter As Long) As Long Private Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, ByVal pDefault As Long) As Long Private Declare Function StartDocPrinter Lib "winspool.drv" Alias "StartDocPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, pDocInfo As DOCINFO) As Long Private Declare Function StartPagePrinter Lib "winspool.drv" (ByVal hPrinter As Long) As Long Private Declare Function WritePrinter Lib "winspool.drv" (ByVal hPrinter As Long, pBuf As Any, ByVal cdBuf As Long, pcWritten As Long) As Long Public Sub GSN_Print(NamaFile As String, DataPrint As String) Dim lhPrinter As Long Dim lReturn As Long Dim lpcWritten As Long Dim lDoc As Long Dim sWrittenData As String Dim MyDocInfo As DOCINFO lReturn = OpenPrinter(Printer.DeviceName, lhPrinter, 0) If lReturn = 0 Then MsgBox "Printer tidak dikenali!", vbCritical, "Error" Exit Sub End If MyDocInfo.pDocName = NamaFile MyDocInfo.pOutputFile = vbNullString MyDocInfo.pDatatype = "RAW" lDoc = StartDocPrinter(lhPrinter, 1, MyDocInfo) Call StartPagePrinter(lhPrinter) sWrittenData = vbCrLf & DataPrint & vbCrLf ' vbFormFeed lReturn = WritePrinter(lhPrinter, ByVal sWrittenData, Len(sWrittenData), lpcWritten) lReturn = EndPagePrinter(lhPrinter) lReturn = EndDocPrinter(lhPrinter) lReturn = ClosePrinter(lhPrinter) End Sub Private Sub Command1_Click() Dim NamaFile As String Dim DataPrint As String NamaFile = "Data yang diprint" DataPrint = "Hello" Call GSN_Print(NamaFile, DataPrint) End Sub Kirim email secara massal Sipan dengan nama email.txt -------------------------------- sanricoster@gmail.com linda_neh@yahoo.com pelangi_senja48@yahoo.com last_three01@yahoo.com lady_rain_2307@yahoo.com prap_indogirl@yahoo.com rezaintan@yahoo.com r_hertawan@yahoo.com siti413@yahoo.com ----------------------------- <? //file kirim_email.php $isiemail="Informasi Spesial di bulan Maret 2008 Jika Anda Bisa Mengetik Dan Mengakses Internet,<br> Anda Sudah Memiliki Syarat Yang Cukup Untuk Menghasilkan Uang Melimpah<br> Dari Bisnis Internet - Hanya Jika Anda Tahu Rahasianya.<br> Joko Susilo, ST<br> Bagaimana Saya Menghasilkan 1,6 Milyar<br> (Rp 70juta per bulan) Hanya Dengan Menjual Informasi Sederhana Melalui Internet!<br> http://www.formulabisnis.com/?id=xsan<br> http://www.klikdisini.com/orangkaya<br>"; echo $isiemail; ?> <br> <br> <div style="display:none"> <? $subject = 'Menghasilkan Uang Melimpah'; $message = $isiemail; $headers = 'From: xsan@formulabisnis.com'; $filez="email.txt"; $data = fread(fopen($filez, "r"), filesize($filez)); $data_split = split("\n", $data); $i = 0; while ($i < count($data_split)-1) { $to=$data_split[$i]; mail($to, $subject, $message, $headers); //echo $to; echo "<br>"; $i++; } ?> </div> Fungsi Terbilang Public Function Terbilang(strAngka As String) As String Dim strJmlHuruf$, intPecahan As Integer, strPecahan$, Urai$, Bil1$, strTot$, Bil2$ Dim x, y, Z As Integer If strAngka = "" Then Exit Function strJmlHuruf = LTrim(strAngka) intPecahan = Val(right(Mid(strAngka, 15, 2), 2)) If (intPecahan = 0) Then strPecahan = "" Else strPecahan = LTrim(Str(intPecahan)) + "/100 " End If x = 0 y = 0 Urai = "" While (x < Len(strJmlHuruf)) x = x + 1 strTot = Mid(strJmlHuruf, x, 1) y = y + Val(strTot) Z = Len(strJmlHuruf) - x + 1 Select Case Val(strTot) Case 1 If (Z = 1 Or Z = 7 Or Z = 10 Or Z = 13) Then Bil1 = "Satu " ElseIf (Z = 4) Then If (x = 1) Then Bil1 = "Se" Else Bil1 = "Satu " End If ElseIf (Z = 2 Or Z = 5 Or Z = 8 Or Z = 11 Or Z = 14) Then x = x + 1 strTot = Mid(strJmlHuruf, x, 1) Z = Len(strJmlHuruf) - x + 1 Bil2 = "" Select Case Val(strTot) Case 0 Bil1 = "Sepuluh " Case 1 Bil1 = "Sebelas " Case 2 Bil1 = "Dua Belas " Case 3 Bil1 = "Tiga Belas " Case 4 Bil1 = "Empat Belas " Case 5 Bil1 = "Lima Belas " Case 6 Bil1 = "Enam Belas " Case 7 Bil1 = "Tujuh Belas " Case 8 Bil1 = "Delapan Belas " Case 9 Bil1 = "Sembilan Belas " End Select Else Bil1 = "Se" End If Case 2 Bil1 = "Dua " Case 3 Bil1 = "Tiga " Case 4 Bil1 = "Empat " Case 5 Bil1 = "Lima " Case 6 Bil1 = "Enam " Case 7 Bil1 = "Tujuh " Case 8 Bil1 = "Delapan " Case 9 Bil1 = "Sembilan " Case Else Bil1 = "" End Select If (Val(strTot) > 0) Then If (Z = 2 Or Z = 5 Or Z = 8 Or Z = 11 Or Z = 14) Then Bil2 = "Puluh " ElseIf (Z = 3 Or Z = 6 Or Z = 9 Or Z = 12 Or Z = 15) Then Bil2 = "Ratus " Else Bil2 = "" End If Else Bil2 = "" End If If (y > 0) Then Select Case Z Case 4 Bil2 = Bil2 + "Ribu " y = 0 Case 7 Bil2 = Bil2 + "Juta " y = 0 Case 10 Bil2 = Bil2 + "Milyar " y = 0 Case 13 Bil2 = Bil2 + "Trilyun " y = 0 End Select End If Urai = Urai + Bil1 + Bil2 Wend Urai = Urai + strPecahan Terbilang = Urai End Function Menampilkan Cuplikan Berita <? $sql=mysql_query("select * from warta"); while($rs=mysql_fetch_object($sql)){ ?> <span id="judul"><?=$rs->judul;?></span> ( <span id="tanggal"><?=$rs->tanggal;?></span> ) <br><br> <? $isiberita=$rs->berita; $tmpbagianberita=array(); $tmp=explode("/n",$isiberita); for($i=0;$i<=4;$i++){ $tmpbagianberita[$i]=$tmp[$i]; } $bagianberita=implode("<br>",$tmpbagianberita); echo $bagianberita." <i><a href='warta_lengkap.php&id=$rs->Id'>selengkapnya</a></i>"; echo "<br><hr><br>"; }?> Membuat Koneksi String pada Visual Basic Dim conn As New ADODB.Connection Dim rs As New ADODB.Recordset Dim SQL as String SQL="Provider=SQLOLEDB.1;Persist Security Info=True;Password=123; User ID=sa;Initial Catalog=database;Data Source=." 'Buka Koneksi conn.Open SQL With MSHFlexGrid1 .Cols = 3 .ColWidth(0) = 700 .ColWidth(1) = 1700 .ColWidth(2) = 2000 .ColWidth(3) = 1200 .TextMatrix(0, 0) = "No" .TextMatrix(0, 1) = "Kode" .TextMatrix(0, 2) = "Nama" .TextMatrix(0, 3) = "Harga" End With With MSHFlexGrid1 .Rows = 2 For i = 0 To .Cols - 1 .TextMatrix(1, i) = "" Next i End With i = 0 rs.Open "select * from barang",conn Do While Not rs.EOF i = i + 1 With MSHFlexGrid1 .TextMatrix(.Rows - 1, 0) = i & "" .TextMatrix(.Rows - 1, 1) = rs!kode & "" .TextMatrix(.Rows - 1, 2) = rs!nama & "" .TextMatrix(.Rows - 1, 3) = rs!harga & "" .AddItem "" End With rs.MoveNext Loop rs.Close conn.Close Combobox di VB.NET Sub BindingKategori() Dim jml As Integer Dim strSqlSelect As String jml = 0 If Koneksi() = True Then strSqlSelect = "select s1,s2 from perusahaan" rs = New SqlCommand(strSqlSelect, conn) dtadapter = New SqlClient.SqlDataAdapter ds = New DataSet 'conn.Open() 'rs.CommandText = strSqlSelect 'rs.CommandType = CommandType.Text dtadapter.SelectCommand = rs dtadapter.Fill(ds) cmb_Kategori.DataSource = ds.Tables(0) cmb_Kategori.DisplayMember = "s2" cmb_Kategori.ValueMember = "s1" ElseIf Koneksi() = False Then MessageBox.Show("koneksi gagal") End End If End Sub Menyimpan Gambar Logo dalam database Private Sub Logo_Click() On Error GoTo errx With cmdDiag .Filter = "All Files (*.*)|*.*|Pictures (*.bmp;*.gif;*.jpg;*wmf)|*.bmp;*.gif;*.jpg;*.wmf" .ShowOpen If .FileName <> "" Then Set Logo.Picture = LoadPicture(.FileName) Logo.Tag = .FileName SimpanLogo .FileName, Logo End If End With Exit Sub errx: MsgBox Err.Description, , "Error Load Logo" End Sub Sub SimpanLogo(pathGambar As String, Img As Image) Dim mstream As ADODB.Stream Dim conn As New ADODB.Connection Dim rs As New ADODB.Recordset conn.Open "Provider=SQLOLEDB.1;Persist Security Info=True;Password=123; User ID=sa;Initial Catalog=database;Data Source=." Set mstream = New ADODB.Stream mstream.Type = adTypeBinary mstream.Open mstream.LoadFromFile pathGambar conn.BeginTrans rs.Open "SELECT * FROM SETTING", conn, adOpenKeyset, adLockOptimistic rs.Fields("Logo").Value = mstream.Read rs.Update rs.Close conn.CommitTrans Set Img.Picture = LoadPicture(pathGambar) conn.Close Set rs = Nothing Set conn = Nothing Exit Sub errx: conn.RollbackTrans MsgBox Err.Description, , "Error Simpan Logo" End Sub Data Report Private Sub DataReport_Initialize() Dim rs As New ADODB.Recordset rs.Open "select * from laporan where tanggaltransaksi=#" & Format(Tanggal, "MM/dd/yyyy") & "#", Conn Set rptLaporan.DataSource = rs rptLaporan.Sections("section4").Controls("lbtanggal").Caption = Format(Tanggal, "dd MMMM yyyy") rptLaporan.Refresh End Sub Konek ke database Mysql <% Set conn=Server.CreateObject("ADODB.Connection") conn.Open "DRIVER={MySQL ODBC 3.51 Driver};SERVER=localhost;DATABASE=database;User Id=root;Password=;" %> Konek SQL SERVER dengan Koneksi String public koneksi hconn="Driver={SQL Server};Server=.;UID=sa;PWD=123;Database=latihan" koneksi=sqlstringconnect(hconn) if koneksi<=0 then messagebox("koneksi gagal",0+64,"Informasi") return endif =sqlexec(koneksi,"select * from lat1","clat1") *hjthisform.grid1.recordsourcetype=1 thisform.grid1.recordsource="clat1" *=sqlexec(koneksi,"insert into lat1 values('sasa','karang anyar')") PHP Connect MsAccess <? $conn = new COM("ADODB.Connection") ; $sql = "DRIVER={Microsoft Access Driver (*.mdb)};DBQ=". realpath("./database.mdb") ." ;uid=admin ;pwd="123";" ; $conn->open($sql); $rs = $conn->execute("SELECT * FROM Barang"); while (!$rs->EOF) { echo $rs->Fields['kode']->Value ; echo $rs->Fields['nama']->Value ; $rs->MoveNext() ; } $rs->Close() ; $conn->Close() ; ?> Format Uang pada Textbox 'Format Uang Private Sub Text1_Change() Text1.Text = Format(Text1.Text, "###,###,###") Text1.SelStart = Len(Text1.Text) End Sub 'Hanya bisa dimasukkan angka 0-9 atau Backspace Private Sub Text1_KeyPress(KeyAscii As Integer) If Not (KeyAscii >= Asc("0") And KeyAscii <= Asc("9") Or KeyAscii = vbKeyBack) Then Beep KeyAscii = 0 Else KeyAscii = KeyAscii End If End Sub Membuat Ikon pada Website yang terletak di url <link rel="Shortcut Icon" href="images/Index.ico"> Fungsi Print Recordset 'Panggil Fungsi Print Recordset PrintRecordSet rs, Printer 'Fungsi Print Recordset Public Function PrintRecordSet(Rs As Recordset, PRN As Printer) ' Use .75 inch margins. Const TOP_MARGIN = 1440 * 0.5 Const LEFT_MARGIN = 1440 * 0.75 Dim lCurrentPos As Long Dim sCurrentField As String Dim bChange() As Boolean Dim iLongest As Integer Dim lShorten As Long Dim i As Integer Dim x As Long Dim lTotalHeaderLength As Long Dim maxWidthPerLine As Long Dim lLineWidth As Long Dim maxFlengths() As Long Dim fStartPos() As Long Dim BM As Single Dim numFields As Integer Dim lFlengths() As Long Dim sFNames() As String Dim lFHeaderlenghts() As Long Dim iNumToExpand As Integer Dim PLines As Integer Dim lCurrentY As Long Dim Tlen As Integer Dim LowY As Long numFields = Rs.Fields.Count - 1 ReDim lFlengths(numFields) ReDim sFNames(numFields) ReDim lFHeaderlenghts(numFields) ReDim maxFlengths(numFields) ReDim bChange(numFields) ReDim fStartPos(numFields) ReDim fEndPos(numFields) On Error GoTo errx 'set bottom margin to an inch BM = PRN.ScaleTop + PRN.ScaleHeight - 1440 maxWidthPerLine = PRN.Width - (LEFT_MARGIN * 2) maxWidthPerLine = maxWidthPerLine - (100 * numFields) For i = 0 To numFields sFNames(i) = Rs.Fields(i).Name ' maxFlengths(i) = PRN.TextWidth(sFNames(i)) + 100 lFHeaderlenghts(i) = PRN.TextWidth(sFNames(i)) lTotalHeaderLength = lTotalHeaderLength + lFHeaderlenghts(i) Next 'get longest text in all fields Rs.MoveFirst Do While Rs.EOF <> True For i = 0 To numFields sCurrentField = Rs(i) & "" If PRN.TextWidth(sCurrentField) > maxFlengths(i) Then maxFlengths(i) = PRN.TextWidth(sCurrentField) End If Next i Rs.MoveNext Loop For i = 0 To numFields If lFHeaderlenghts(i) > maxFlengths(i) Then lFlengths(i) = lFHeaderlenghts(i) bChange(i) = False Else lFlengths(i) = maxFlengths(i) bChange(i) = True iNumToExpand = iNumToExpand + 1 End If lLineWidth = lLineWidth + lFlengths(i) Next 'determine linewidths Do While lLineWidth > maxWidthPerLine iLongest = 1 For i = 0 To numFields If lFlengths(i) > lFlengths(iLongest) Then iLongest = i End If Next lShorten = 0.05 * (lFlengths(iLongest)) lFlengths(iLongest) = lFlengths(iLongest) - lShorten lLineWidth = lLineWidth - lShorten Loop lCurrentPos = LEFT_MARGIN For i = 0 To numFields fStartPos(i) = lCurrentPos If i <= numFields Then lCurrentPos = lCurrentPos + lFlengths(i) + 100 End If Debug.Print CStr(fStartPos(i)) & " " & CStr(lFlengths(i)) Next i Rs.MoveFirst Printer.CurrentX = TOP_MARGIN Printer.CurrentY = LEFT_MARGIN For i = 0 To numFields PRN.CurrentX = fStartPos(i) PRN.Print sFNames(i); Next i PRN.Print PRN.Line (LEFT_MARGIN, PRN.CurrentY)-(PRN.Width - LEFT_MARGIN, PRN.CurrentY) Do While Rs.EOF = False 'print a line lCurrentY = PRN.CurrentY For i = 0 To numFields PRN.CurrentX = fStartPos(i) sCurrentField = Rs.Fields(i) & "" If PRN.TextWidth(sCurrentField) > lFlengths(i) Then PRN.CurrentY = lCurrentY PLines = PRN.TextWidth(sCurrentField) \ lFlengths(i) + 1 Tlen = Len(sCurrentField) / PLines PRN.Print left(sCurrentField, Tlen); For x = 2 To PLines PRN.Print PRN.CurrentX = fStartPos(i) PRN.Print Mid(sCurrentField, (x - 1) * Tlen + 1, Tlen); If PRN.CurrentY > LowY Then LowY = PRN.CurrentY End If Next x Else PRN.CurrentY = lCurrentY PRN.Print sCurrentField; If PRN.CurrentY > LowY Then LowY = PRN.CurrentY End If End If Next i If PRN.CurrentY >= BM Then ' Start a new page. PRN.NewPage PRN.CurrentY = TOP_MARGIN Printer.CurrentX = TOP_MARGIN Printer.CurrentY = LEFT_MARGIN LowY = PRN.CurrentY For i = 1 To numFields PRN.CurrentX = fStartPos(i) PRN.Print sFNames(i); Next i PRN.Print PRN.Line (LEFT_MARGIN, PRN.CurrentY)-(PRN.Width - LEFT_MARGIN, PRN.CurrentY) Else PRN.CurrentY = LowY PRN.Print PRN.Line (LEFT_MARGIN, PRN.CurrentY)-(PRN.Width - LEFT_MARGIN, PRN.CurrentY) End If Rs.MoveNext Loop Printer.EndDoc Exit Function errx: MsgBox Err.Description, , "Error Print" End Function Query SQL SERVER dengan CASE WHEN SELECT title, pub_id, CASE WHEN price IS NULL THEN (SELECT MIN(price) FROM titles) ELSE price END FROM titles Halaman Sederhana WAP, PHP <? header("Content-type: text/vnd.wap.wml"); echo "<?xml version=\"1.0\"?>"; echo "<!DOCTYPE wml PUBLIC \"-//WAPFORUM//DTD WML 1.1//EN\"" . " \"http://www.wapforum.org/DTD/wml_1.1.xml\">"; ?> <wml> <card id="card1" title=""> <p align="center"><br /> <b style="font-size:11px">Welcome To Jungle</b><br/> <? $date = date("D, M d Y"); print "<small>$date</small>"; ?><br /> <a href="home.php" style="font-size:11px">Masuk</a><br /> </p> </card> </wml> WINDOW POPUP <script language="javascript"> function pop_window(url){ var popit=window.open(url,'console','toolbar=no,location=no,directories=no,status=no,scrollbars,resizable,width=750,height=430'); } </script> <a href="javascript:pop_window('http://www.kimplay.co.cc');">KLIK ME</a> Tombol XP Style Simpan Kode Ini Dengan Nama VB6.EXE.Manifest / Nama Program .EXE.Manifest, Letakkan satu folder dengan program / aplikasi <?xml version="1.0" encoding="UTF-8" standalone="yes"?> <assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0"> <assemblyIdentity version="1.0.0.0" processorArchitecture="X86" name="Microsoft.VisualBasic6.IDE" type="win32" /> <description>Microsoft Visual Basic 6 IDE</description> <dependency> <dependentAssembly> <assemblyIdentity type="win32" name="Microsoft.Windows.Common-Controls" version="6.0.0.0" processorArchitecture="X86" publicKeyToken="6595b64144ccf1df" language="*" /> </dependentAssembly> </dependency> </assembly> Membaca file txt 'Deklarasi Public Declare Function SystemParametersInfo Lib "user32" Alias _ "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, _ ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long Declare Function GetPrivateProfileString Lib "kernel32.dll" Alias _ "GetPrivateProfileStringA" (ByVal lpApplicationName As String, _ ByVal lpKeyName As Any, ByVal lpDefault As String, _ ByVal lpReturnedString As String, ByVal nSize As Long, _ ByVal lpFileName As String) As Long Public Declare Function WritePrivateProfileString Lib "kernel32" Alias _ "WritePrivateProfileStringA" (ByVal lpApplicationName As String, _ ByVal lpKeyName As Any, ByVal lpString As Any, _ ByVal lpFileName As String) As Long dim Public NamaSistem As String 'buat fungsi membaca file Function BacaINI(Section As String, Key As String) As String Dim INI As String Dim Buffer As String * 255 Dim x As Long INI = App.Path & "\config.txt" x = GetPrivateProfileString(Section, Key, "", Buffer, 255, INI) BacaINI = left(Buffer, x) End Function 'memanggil fungsi BacaINI untuk membaca file config.txt pada Kategori Sistem,Sub Kategori Nama NamaSistem = BacaINI("Sistem", "Nama") 'Isi File config.txt / Simpan kode di bawah dengan nama config.txt [Sistem] Nama=Sistem Informasi Membaca file txt per baris <? $lines = file('email.txt'); $i=0; foreach ($lines as $line_num => $line) { echo htmlspecialchars($line) . "<br />\n"; // tiap baris dapat di split lagi //$dt = split(";", $line); //echo $dt[0]." ".$dt[1]; $i++; } ?> Sending e-mail with CDOSYS Examples using CDOSYS <% Set myMail=CreateObject("CDO.Message") myMail.Subject="Sending email with CDO" myMail.From="mymail@mydomain.com" myMail.To="someone@somedomain.com" myMail.TextBody="This is a message." myMail.Send set myMail=nothing %> Sending a text e-mail with Bcc and CC fields: <% Set myMail=CreateObject("CDO.Message") myMail.Subject="Sending email with CDO" myMail.From="mymail@mydomain.com" myMail.To="someone@somedomain.com" myMail.Bcc="someoneelse@somedomain.com" myMail.Cc="someoneelse2@somedomain.com" myMail.TextBody="This is a message." myMail.Send set myMail=nothing %> Sending an HTML e-mail: <% Set myMail=CreateObject("CDO.Message") myMail.Subject="Sending email with CDO" myMail.From="mymail@mydomain.com" myMail.To="someone@somedomain.com" myMail.HTMLBody = "<h1>This is a message.</h1>" myMail.Send set myMail=nothing %> Sending an HTML e-mail that sends a webpage from a website: <% Set myMail=CreateObject("CDO.Message") myMail.Subject="Sending email with CDO" myMail.From="mymail@mydomain.com" myMail.To="someone@somedomain.com" myMail.CreateMHTMLBody "http://www.w3schools.com/asp/" myMail.Send set myMail=nothing %> Sending an HTML e-mail that sends a webpage from a file on your computer: <% Set myMail=CreateObject("CDO.Message") myMail.Subject="Sending email with CDO" myMail.From="mymail@mydomain.com" myMail.To="someone@somedomain.com" myMail.CreateMHTMLBody "file://c:/mydocuments/test.htm" myMail.Send set myMail=nothing %> Sending a text e-mail with an Attachment: <% Set myMail=CreateObject("CDO.Message") myMail.Subject="Sending email with CDO" myMail.From="mymail@mydomain.com" myMail.To="someone@somedomain.com" myMail.TextBody="This is a message." myMail.AddAttachment "c:\mydocuments\test.txt" myMail.Send set myMail=nothing %> Sending a text e-mail using a remote server: <% Set myMail=CreateObject("CDO.Message") myMail.Subject="Sending email with CDO" myMail.From="mymail@mydomain.com" myMail.To="someone@somedomain.com" myMail.TextBody="This is a message." myMail.Configuration.Fields.Item _ ("http://schemas.microsoft.com/cdo/configuration/sendusing")=2 'Name or IP of remote SMTP server myMail.Configuration.Fields.Item _ ("http://schemas.microsoft.com/cdo/configuration/smtpserver") _ ="smtp.server.com" 'Server port myMail.Configuration.Fields.Item _ ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") _ =25 myMail.Configuration.Fields.Update myMail.Send set myMail=nothing %> Scroll Banner <style type="text/css"> #topbar{ position:absolute; border: 1px solid black; padding: 2px; background-color: lightyellow; width: 620px; visibility: hidden; z-index: 100; } </style> <script type="text/javascript"> var persistclose=0 //set to 0 or 1. 1 means once the bar is manually closed, it will remain closed for browser session var startX = 30 //set x offset of bar in pixels var startY = 5 //set y offset of bar in pixels var verticalpos="fromtop" //enter "fromtop" or "frombottom" function iecompattest(){ return (document.compatMode && document.compatMode!="BackCompat")? document.documentElement : document.body } function get_cookie(Name) { var search = Name + "=" var returnvalue = ""; if (document.cookie.length > 0) { offset = document.cookie.indexOf(search) if (offset != -1) { offset += search.length end = document.cookie.indexOf(";", offset); if (end == -1) end = document.cookie.length; returnvalue=unescape(document.cookie.substring(offset, end)) } } return returnvalue; } function closebar(){ if (persistclose) document.cookie="remainclosed=1" document.getElementById("topbar").style.visibility="hidden" } function staticbar(){ barheight=document.getElementById("topbar").offsetHeight var ns = (navigator.appName.indexOf("Netscape") != -1) || window.opera; var d = document; function ml(id){ var el=d.getElementById(id); if (!persistclose || persistclose && get_cookie("remainclosed")=="") el.style.visibility="visible" if(d.layers)el.style=el; el.sP=function(x,y){this.style.left=x+"px";this.style.top=y+"px";}; el.x = startX; if (verticalpos=="fromtop") el.y = startY; else{ el.y = ns ? pageYOffset + innerHeight : iecompattest().scrollTop + iecompattest().clientHeight; el.y -= startY; } return el; } window.stayTopLeft=function(){ if (verticalpos=="fromtop"){ var pY = ns ? pageYOffset : iecompattest().scrollTop; ftlObj.y += (pY + startY - ftlObj.y)/8; } else{ var pY = ns ? pageYOffset + innerHeight - barheight: iecompattest().scrollTop + iecompattest().clientHeight - barheight; ftlObj.y += (pY - startY - ftlObj.y)/8; } ftlObj.sP(ftlObj.x, ftlObj.y); setTimeout("stayTopLeft()", 10); } ftlObj = ml("topbar"); stayTopLeft(); } if (window.addEventListener) window.addEventListener("load", staticbar, false) else if (window.attachEvent) window.attachEvent("onload", staticbar) else if (document.getElementById) window.onload=staticbar </script> <div id="topbar"> <a href="" onClick="closebar(); return false"><img src="close.gif" border="0" /></a> Your content here. </div> Koneksi String database MS SQL SERVER Imports System.Data Imports System.Data.SqlClient Public Class Form1 Private sqlConn As New SqlConnection Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click Dim sqlserv As String = "(local)" Dim sqldb As String = "tes" Dim sqluser As String = "sa" Dim sqlpass As String = "sa" sqlConn.ConnectionString = _ "server=" & sqlserv & ";" & _ "database=" & sqldb & ";" & _ "UID=" & sqluser & ";" & _ "PWD=" & sqlpass Try sqlConn.Open() Catch ex As Exception MessageBox.Show("Connection Failed." & vbCrLf & ErrorToString()) Finally If sqlConn.State = ConnectionState.Open Then MessageBox.Show("Connection Success.") End If End Try End Sub End Class Refresh Halaman Otomatis per 5 detik <meta http-equiv='refresh' content='5' /> Redirect Halaman <? header("location: http://kimplay.co.cc"); ?> TreeView IsiTreeView1 Sub IsiTreeView1() Dim conn As New ADODB.Connection Dim rs As New ADODB.Recordset conn.Open "Provider=SQLOLEDB.1;Persist Security Info=True;Password=123; User ID=sa;Initial Catalog=database;Data Source=." Dim NodeX As Node tvwGuru.Nodes.Clear Set NodeX = tvwGuru.Nodes.Add(, , "kRoot", "Daftar Guru Pengajar") Set rs = conn.execute("select * from guru") While Not rs.EOF Set NodeX = TreeView1.Nodes.Add("kRoot", tvwChild, "k" & rs!Nip, rs!Nip & "-" & rs!Nama) NodeX.Expanded = True NodeX.EnsureVisible rs.MoveNext Wend rs.Close Set rs = Nothing End Sub Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node) MsgBox Node.Key End Sub Memainkan MP3 di Web <embed "1" TYPE="application/x-mplayer2" SRC="angel.mp3" autostart="true" WIDTH="120" HEIGHT="50"></embed> Mencari huruf / kata di dalam string menggunakan eregi <? $text = 'ABCDEFGHIJKLMNOQRSTUVWXYZ'; if (eregi('y', $text)) { echo "'$text' mengandung huruf y"; } ?> Koneksi String database MS Access Imports System.Data Imports System.Data.OleDb Public Class Form1 Dim connect As New OleDbConnection Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Dim s As String s = "Provider=Microsoft.Jet.OLEDB.4.0;" + "Data Source =D:\Kasir.mdb;" connect.ConnectionString = s connect.Open() If connect.State = ConnectionState.Open Then MessageBox.Show("database connect") Else MessageBox.Show("database tidak terhubung") End If End Sub End Class Aneka String 'Konversi Array Byte ke String Dim s As String Dim b(1 To 3) As Byte b(1) = Asc("A") b(2) = Asc("B") b(3) = Asc("C") s = StrConv(b, vbUnicode) MsgBox s 'Ganti Hurul Besar text="tidak semua laki-laki" Print UCase$(text) 'Mengandung sebuah kata Dim s As String text= "indonesia raya merdeka" If InStr(text, "raya")<> 0 Then MsgBox "ketemu" End If 'Ganti String Dim text text="ini ibu budi" s=Replace(text, "i", "a") Login seperti PhpMyAdmin <? if (!isset($_SERVER['PHP_AUTH_USER'])) { header('WWW-Authenticate: Basic realm="LOGIN"'); header('HTTP/1.0 401 Unauthorized'); echo '<font color=red><b>MAAF, ANDA BELUM LOGIN</b></font>'; exit; } else { $user="root"; $password="12345"; if($user==$_SERVER['PHP_AUTH_USER'] && $password==$_SERVER['PHP_AUTH_PW']){ echo "OK"; }else{ header('WWW-Authenticate: Basic realm="LOGIN"'); echo '<font color=red><b>LOGIN SALAH</b></font>'; } } ?> Tulisan Berjalan Ke Atas <marquee direction="up" onMouseOver="this.stop();" onMouseOut="this.start();"> <p> KIMPLAY COMPUTER adalah perusahaan swasta nasional bergerak dibidang Teknologi Informasi yang memberikan solusi dan konsultasi, web design, jaringan serta pengadaan komputer. Kami memberikan pengetahuan, keahlian dan pengalaman serta sudah menjadi komitmen kami untuk melayani dan menjalin hubungan yang baik dengan pelanggan. Dengan komitmen tersebut dan efisiensi kerja.</p> <p> KIMPLAY COMPUTER siap memenuhi permintaan pelanggan yang menetapkan standar tinggi. Untuk mendukung aktivitas perusahaan, kami menyediakan fasilitas seperti pelatihan dan tim dengan kualifikasi yang tinggi serta perlengkapan kerja lainnya. Perusahaan akan terus mengusahakan yang terbaik untuk melayani semua pelanggan kami. Memasuki dunia usaha yang kompetitif, kita perlu memiliki visi yang prospektif dan baik, maka visi kami adalah untuk menyediakan suatu aplikasi yang mudah digunakan, menyederhanakan proses usaha menjadi lebih efektif, efisien dan dapat diukur untuk pengembangan masa depan</p> </marquee> Memanggil Crystal Report rpt.Connect = "DSN=.;UID=sa;PWD=123;DSQ=koperasi" rpt.ReportFileName = App.Path & "/LapJurnalKASMasuk1.rpt" rpt.Formulas(0) = "Tanggal='" & Format(DTPicker1.Value, "dd/MM/yyyy") & " s/d " & Format(DTPicker2.Value, "dd/MM/yyyy") & "'" rpt.SelectionFormula = "{Jurnal.tanggal}>=#" & Format(DTPicker1.Value, "dd/MM/yyyy") & "# AND {Jurnal.tanggal}<=#" & Format(DTPicker2.Value, "dd/MM/yyyy") & "#" rpt.WindowTitle = "Laporan Jurnal Kas Masuk" rpt.WindowState = crptMaximized rpt.RetrieveDataFiles rpt.Action = 1 Memberi warna baris tertentu pada Grid With MSHFlexGrid1 .Row = 1 For x = 1 To .Rows - 2 .Row = x If (Val(.TextMatrix(.Row, 4)) < Val(.TextMatrix(.Row, 5))) Then For z = 0 To .Cols .CellBackColor = vbRed .Col = .Col + 1 Next z End If Next x End With Fungsi Rp function rupiah($rp){ $a=$rp; $b=explode(".",$a); $rp=$b[0]; $koma=$b[1]; if($koma=="" || $koma==0) $koma="-"; $rupiah=""; $p=strlen($rp); while($p>3) { $rupiah=".".substr($rp,-3).$rupiah; $l=strlen($rp)-3; $rp=substr($rp,0,$l); $p=strlen($rp); } $rupiah="Rp ".$rp.$rupiah.",".$koma; return $rupiah; } Membuat Barcode dengan php <? /*===========================================================================*/ /* PARAMETERS: ----------- $barcode = [required] The barcode you want to generate $type = (default=0) It's 0 for Code 3 of 9 (the only one supported) $width = (default=160) Width of image in pixels. The image MUST be wide enough to handle the length of the given value. The default value will probably be able to display about 6 digits. If you get an error message, make it wider! $height = (default=80) Height of image in pixels $format = (default=jpeg) Can be "jpeg", "png", or "gif" $quality = (default=100) For JPEG only: ranges from 0-100 $text = (default='') 0 Enter any string to be displayed USAGE EXAMPLES FOR ANY PLAIN OLD HTML DOCUMENT: ----------------------------------------------- <IMG SRC="barcode.php?barcode=HELLO&quality=75"> <IMG SRC="barcode.php?barcode=123456&width=320&height=200"> */ /*=============================================================================*/ //----------------------------------------------------------------------------- // Startup code //----------------------------------------------------------------------------- if(isset($_GET["text"])) $text=$_GET["text"]; if(isset($_GET["format"])) $format=$_GET["format"]; if(isset($_GET["quality"])) $quality=$_GET["quality"]; if(isset($_GET["width"])) $width=$_GET["width"]; if(isset($_GET["height"])) $height=$_GET["height"]; if(isset($_GET["type"])) $type=$_GET["type"]; if(isset($_GET["barcode"])) $barcode=$_GET["barcode"]; //$barcode =123456; //$type =1; //$width =200; //$height =100; //$format ="jpeg"; //$quality =75; //$text ='123456'; if (!isset ($text)) $text = ''; if (!isset ($type)) $type = 1; if (empty ($quality)) $quality = 100; if (empty ($width)) $width = 160; if (empty ($height)) $height = 80; if (!empty ($format)) $format = strtoupper ($format); else $format="PNG"; switch ($type) { default: $type = 1; case 1: Barcode39 ($barcode, $width, $height, $quality, $format, $text); break; } //----------------------------------------------------------------------------- // Generate a Code 3 of 9 barcode //----------------------------------------------------------------------------- function Barcode39 ($barcode, $width, $height, $quality, $format, $text) { switch ($format) { default: $format = "JPEG"; case "JPEG": header ("Content-type: image/jpeg"); break; case "PNG": header ("Content-type: image/png"); break; case "GIF": header ("Content-type: image/gif"); break; } $im = ImageCreate ($width, $height) or die ("Cannot Initialize new GD image stream"); $White = ImageColorAllocate ($im, 255, 255, 255); $Black = ImageColorAllocate ($im, 0, 0, 0); //ImageColorTransparent ($im, $White); ImageInterLace ($im, 1); $NarrowRatio = 20; $WideRatio = 55; $QuietRatio = 35; $nChars = (strlen($barcode)+2) * ((6 * $NarrowRatio) + (3 * $WideRatio) + ($QuietRatio)); $Pixels = $width / $nChars; $NarrowBar = (int)(20 * $Pixels); $WideBar = (int)(55 * $Pixels); $QuietBar = (int)(35 * $Pixels); $ActualWidth = (($NarrowBar * 6) + ($WideBar*3) + $QuietBar) * (strlen ($barcode)+2); if (($NarrowBar == 0) || ($NarrowBar == $WideBar) || ($NarrowBar == $QuietBar) || ($WideBar == 0) || ($WideBar == $QuietBar) || ($QuietBar == 0)) { ImageString ($im, 1, 0, 0, "Image is too small!", $Black); OutputImage ($im, $format, $quality); exit; } $CurrentBarX = (int)(($width - $ActualWidth) / 2); $Color = $White; $BarcodeFull = "*".strtoupper ($barcode)."*"; settype ($BarcodeFull, "string"); $FontNum = 3; $FontHeight = ImageFontHeight ($FontNum); $FontWidth = ImageFontWidth ($FontNum); if ($text != '') { $CenterLoc = (int)(($width) / 2) - (int)(($FontWidth * strlen($text)) / 2); ImageString ($im, $FontNum, $CenterLoc, $height-$FontHeight, "$text", $Black); } for ($i=0; $i<strlen($BarcodeFull); $i++) { $StripeCode = Code39 ($BarcodeFull[$i]); for ($n=0; $n < 9; $n++) { if ($Color == $White) $Color = $Black; else $Color = $White; switch ($StripeCode[$n]) { case '0': ImageFilledRectangle ($im, $CurrentBarX, 0, $CurrentBarX+$NarrowBar, $height-1-$FontHeight-2, $Color); $CurrentBarX += $NarrowBar; break; case '1': ImageFilledRectangle ($im, $CurrentBarX, 0, $CurrentBarX+$WideBar, $height-1-$FontHeight-2, $Color); $CurrentBarX += $WideBar; break; } } $Color = $White; ImageFilledRectangle ($im, $CurrentBarX, 0, $CurrentBarX+$QuietBar, $height-1-$FontHeight-2, $Color); $CurrentBarX += $QuietBar; } OutputImage ($im, $format, $quality); } //----------------------------------------------------------------------------- // Output an image to the browser //----------------------------------------------------------------------------- function OutputImage ($im, $format, $quality) { switch ($format) { case "JPEG": ImageJPEG ($im, "", $quality); break; case "PNG": ImagePNG ($im); break; case "GIF": ImageGIF ($im); break; } } //----------------------------------------------------------------------------- // Returns the Code 3 of 9 value for a given ASCII character //----------------------------------------------------------------------------- function Code39 ($Asc) { switch ($Asc) { case ' ': return "011000100"; case '$': return "010101000"; case '%': return "000101010"; case '*': return "010010100"; // * Start/Stop case '+': return "010001010"; case '|': return "010000101"; case '.': return "110000100"; case '/': return "010100010"; case '0': return "000110100"; case '1': return "100100001"; case '2': return "001100001"; case '3': return "101100000"; case '4': return "000110001"; case '5': return "100110000"; case '6': return "001110000"; case '7': return "000100101"; case '8': return "100100100"; case '9': return "001100100"; case 'A': return "100001001"; case 'B': return "001001001"; case 'C': return "101001000"; case 'D': return "000011001"; case 'E': return "100011000"; case 'F': return "001011000"; case 'G': return "000001101"; case 'H': return "100001100"; case 'I': return "001001100"; case 'J': return "000011100"; case 'K': return "100000011"; case 'L': return "001000011"; case 'M': return "101000010"; case 'N': return "000010011"; case 'O': return "100010010"; case 'P': return "001010010"; case 'Q': return "000000111"; case 'R': return "100000110"; case 'S': return "001000110"; case 'T': return "000010110"; case 'U': return "110000001"; case 'V': return "011000001"; case 'W': return "111000000"; case 'X': return "010010001"; case 'Y': return "110010000"; case 'Z': return "011010000"; default: return "011000100"; } } ?> Menampilkan Jam Komputer <html> <head> <script type="text/javascript"> function mulai() { var today=new Date() var h=today.getHours() var m=today.getMinutes() var s=today.getSeconds() m=cek(m) s=cek(s) document.getElementById('jam').innerHTML=h+":"+m+":"+s t=setTimeout('startTime()',500) } function cek(i) { if (i<10) {i="0" + i} return i } </script> </head> <body onload="mulai()"> <div id="jam"></div> </body> </html> Export ke Excel <% Response.ContentType = "application/vnd.ms-excel" Response.AddHeader "Content-Disposition","attachment; filename=File.xls;" %> Fungsi Format Uang function FormatUang( u ) n=len(u) if (n>3 and n<=6) then p=right(u,3) c=mid(u,1,n-3) FormatUang=c & "." & p elseif (n>6 and n<=9) then r=right(u,3) p=right(u,6) c=mid(p,1,3) c=c & "." & r p=mid(u,1,n-6) FormatUang=p & "." & c elseif (n>9 and n<=12) then s=right(u,3) r=mid(right(u,6),1,3) c=mid(right(u,9),1,3) c=c & "." & r & "." & s p=mid(u,1,n-9) FormatUang=p & "." & c elseif (n>12 and n<=15) then s=right(u,3) r=mid(right(u,6),1,3) c=mid(right(u,9),1,3) b=mid(right(u,12),1,3) c=b & "." &c & "." & r & "." & s p=mid(u,1,n-12) FormatUang=p & "." & c else FormatUang=u end if end function Query Random 'Select a random row with MySQL: SELECT column FROM table ORDER BY RAND() LIMIT 1 'Select a random row with PostgreSQL: SELECT column FROM table ORDER BY RANDOM() LIMIT 1 'Select a random row with Microsoft SQL Server: SELECT TOP 1 column FROM table ORDER BY NEWID() 'Select a random row with IBM DB2 SELECT column, RAND() as IDX FROM table ORDER BY IDX FETCH FIRST 1 ROWS ONLY 'Select a random record with Oracle: SELECT column FROM ( SELECT column FROM table ORDER BY dbms_random.value ) WHERE rownum = 1 Print Struk 2 Dim I, RECORD, NO, DATA, DATA2, DATA3, DATA4 Open "USB001" For Input As #1 Printer.Width = 20000 Printer.CurrentX = 0 Printer.CurrentY = 0 Printer.ScaleMode = vbCentimeters Printer.FontName = "Arial" Printer.FontSize = 12 Printer.FontBold = True Printer.Print Tab(5); Trim("Toko Cat Gaya Warna") Printer.FontSize = 10 Printer.Print Tab(5); Trim("Jl. Raya Tajur No.168B - BOGOR") Printer.Print Tab(5); Trim("Telp/Fax 0251-331908") Printer.Print "" Printer.FontSize = 8 Printer.Print Tab(20); Trim("Tanggal : " + Me.Label_Waktu) Printer.Print Tab(20); Trim("No Faktur : " + Me.Txt_No_Faktur) Printer.FontBold = False Printer.Print Tab(5); "----------------------------------------------------------------------------------------------------------" Printer.Print Tab(5); "No. Item Qty Harga Jumlah" Printer.Print Tab(5); "----------------------------------------------------------------------------------------------------------" Me.Data_Detail.Recordset.MoveLast RECORD = Me.Data_Detail.Recordset.RecordCount Me.Data_Detail.Recordset.MoveFirst NO = 1 For I = 1 To RECORD DATA = Me.DBGrid_Detail.Columns(4) DATA2 = Me.DBGrid_Detail.Columns(8) DATA3 = Me.DBGrid_Detail.Columns(7) DATA4 = Me.DBGrid_Detail.Columns(8) * Me.DBGrid_Detail.Columns(7) Printer.Print Tab(5); NO & Space(5) & DATA & Space(10) & DATA2 & Space(10) & DATA3 & Space(20) & DATA4 NO = NO + 1 Me.Data_Detail.Recordset.MoveNext Next I Printer.Print Tab(5); "---------------------------------------------------------------------------------------------------------" Printer.FontSize = 10 Printer.Print Tab(35); "Sub Total : " & Me.MaskEdBox_Subtotal [color=#FF0000]Titik duanya kaga rata kebawah [/color] Printer.Print Tab(35); "Discount Faktur : " & Me.MaskEdBox_Tot_Disc Printer.Print Tab(35); "PPn : " & Me.MaskEdBox_Pajak Printer.Print Tab(35); "Total : " & Me.MaskEdBox_Jumlah_Bayar Printer.Print Tab(35); "Bayar : " & Me.MaskEdBox_Total Printer.Print Tab(35); "Kembali : " & Me.MaskEdBox_Kembali WriteToPrinter "" Printer.EndDoc Close #1 Database Connect String Microsoft Access Connect Database For Standard Security: oConn.Open "Driver={Microsoft Access Driver (*.mdb)};" & _ "Dbq=c:\somepath\mydb.mdb;" & _ "Uid=admin;" & _ "Pwd=" If you are using a Workgroup (System database): oConn.Open "Driver={Microsoft Access Driver (*.mdb)};" & _ "Dbq=c:\somepath\mydb.mdb;" & _ "SystemDB=c:\somepath\mydb.mdw;", _ "myUsername", "myPassword" If want to open up the MDB exclusively oConn.Open "Driver={Microsoft Access Driver (*.mdb)};" & _ "Dbq=c:\somepath\mydb.mdb;" & _ "Exclusive=1;" & _ "Uid=admin;" & _ "Pwd=" If MDB is located on a Network Share oConn.Open "Driver={Microsoft Access Driver (*.mdb)};" & _ "Dbq=\\myServer\myShare\myPath\myDb.mdb;" & _ "Uid=admin;" & _ "Pwd=" If MDB is located on a remote machine - Or use an XML Web Service via SOAP Toolkit or ASP.NET - Or upgrade to SQL Server and use an IP connection string - Or use an ADO URL with a remote ASP web page - Or use a MS Remote or RDS connection string If you don't know the path to the MDB (using ASP) This assumes the MDB is in the same directory where the ASP page is running. Also make sure this directory has Write permissions for the user account. If you don't know the path to the MDB (using VB) oConn.Open "Driver={Microsoft Access Driver (*.mdb)};" & _ "Dbq=" & App.Path & "\myDb.mdb;" & _ "Uid=admin;" & _ "Pwd=" This assumes the MDB is in the same directory where the application is running. ________________________________________ ODBC Driver for AS/400 (from IBM) oConn.Open "Driver={Client Access ODBC Driver (32-bit)};" & _ "System=myAS400;" & _ "Uid=myUsername;" & _ "Pwd=myPassword" For more information, see: A Fast Path to AS/400 Client/Server ________________________________________ ODBC Driver for dBASE oConn.Open "Driver={Microsoft dBASE Driver (*.dbf)};" & _ "DriverID=277;" & _ "Dbq=c:\somepath" Then specify the filename in the SQL statement: oRs.Open "Select * From user.dbf", oConn, , ,adCmdText Note: MDAC 2.1 (or greater) requires the Borland Database Engine (BDE) to update dBase DBF files. (Q238431). For more information, see: dBASE Driver Programming Considerations To view Microsoft KB articles related to Microsoft dBASE Driver, click here ________________________________________ ODBC Driver for Excel oConn.Open "Driver={Microsoft Excel Driver (*.xls)};" & _ "DriverId=790;" & _ "Dbq=c:\somepath\mySpreadsheet.xls;" & _ "DefaultDir=c:\somepath" For more information, see: Microsoft Excel Driver Programming Considerations To view Microsoft KB articles related to Microsoft Excel Driver, click here ________________________________________ ODBC Driver for Informix If using INFORMIX 3.30 ODBC Driver oConn.Open "Dsn='';" & _ "Driver={INFORMIX 3.30 32 BIT};" & _ "Host=myHostname;" & _ "Server=myServerName;" & _ "Service=myServiceName;" & _ "Protocol=olsoctcp;" & _ "Database=myDbName;" & _ "UID=myUsername;" & _ "PWD=myPassword" & _ ' Or oConn.Open "Dsn=myDsn;" & _ "Host=myHostname;" & _ "Server=myServerName;" & _ "Service=myServiceName;" & _ "Protocol=onsoctcp;" & _ "Database=myDbName;" & _ "Uid=myUsername;" & _ "Pwd=myPassword" If using INFORMIX-CLI 2.5 ODBC Driver oConn.Open "Driver={Informix-CLI 2.5 (32 Bit)};" & _ "Server=myServerName;" & _ "Database=myDbName;" & _ "Uid=myUsername;" & _ "Pwd=myPassword" & _ ________________________________________ ODBC Driver for Interbase - from Easysoft For the local machine oConn.Open "Driver={Easysoft IB6 ODBC};" & _ "Server=localhost;" & _ "Database=localhost:C:\Home\Data\Mydb.gdb;" & _ "Uid=myUsername;" & _ "Pwd=myPassword" For a remote machine oConn.Open "Driver={Easysoft IB6 ODBC};" & _ "Server=myMachineName;" & _ "Database=myMachineName:C:\Home\Data\Mydb.gdb;" & _ "Uid=myUsername;" & _ "Pwd=myPassword" For more information, see: Connecting to InterBase and Easysoft ________________________________________ ODBC Driver for Interbase - from InterSolv For the local machine oConn.Open "Driver={INTERSOLV InterBase ODBC Driver (*.gdb)};" & _ "Server=localhost;" & _ "Database=localhost:C:\Home\Data\Mydb.gdb;" & _ "Uid=myUsername;" & _ "Pwd=myPassword" For a remote machine oConn.Open "Driver={INTERSOLV InterBase ODBC Driver (*.gdb)};" & _ "Server=myMachineName;" & _ "Database=myMachineName:C:\Home\Data\Mydb.gdb;" & _ "Uid=myUsername;" & _ "Pwd=myPassword" For more information, see: Google Search (if you know a direct URL email me) ________________________________________ ODBC Driver for Lotus Notes oConn.Open "Driver={Lotus NotesSQL 3.01 (32-bit) ODBC DRIVER (*.nsf)};" & _ "Server=myServerName;" & _ "Database=mydir\myDbName.nsf;" & _ "Uid=myUsername;" & _ "Pwd=myPassword" & _ For more information, see: Connection keywords ________________________________________ ODBC Driver for Mimer oConn.Open "Driver={MIMER};" & _ "Database=myDatabaseName;" & _ "Uid=myUsername;" & _ "Pwd=myPassword" For more information, see: Opening a Connection ________________________________________ ODBC Driver for MySQL (via MyODBC) To connect to a local database (using MyODBC Driver) oConn.Open "Driver={mySQL};" & _ "Server=MyServerName;" & _ "Option=16834;" & _ "Database=mydb" To connect to a remote database oConn.Open "Driver={mySQL};" & _ "Server=db1.database.com;" & _ "Port=3306;" & _ "Option=131072;" & _ "Stmt=;" & _ "Database=mydb;" & _ "Uid=myUsername;" & _ "Pwd=myPassword" To connect to a local database (using MySQL ODBC 3.51 Driver) oConn.Open "DRIVER={MySQL ODBC 3.51 Driver};" & _ "Server=myServerName;" & _ "Port=3306;" & _ "Option=16384;" & _ "Stmt=;" & _ "Database=mydatabaseName;" & _ "Uid=myUsername;" & _ "Pwd=myPassword" Or oConn.Open "DRIVER={MySQL ODBC 3.51 Driver};" & _ "SERVER=myServerName;" & _ "DATABASE=myDatabaseName;" & _ "USER=myUsername;" & _ "PASSWORD=myPassword;" Note: When you first install MySQL, it creates a "root" user account (in the sys datbase's user table) with a blank password. For more information, see: Programs Known to Work with MyODBC ________________________________________ ODBC Driver for Oracle - from Microsoft For the current Oracle ODBC Driver from Microsoft oConn.Open "Driver={Microsoft ODBC for Oracle};" & _ "Server=OracleServer.world;" & _ "Uid=myUsername;" & _ "Pwd=myPassword" For the older Oracle ODBC Driver from Microsoft oConn.Open "Driver={Microsoft ODBC Driver for Oracle};" & _ "ConnectString=OracleServer.world;" & _ "Uid=myUsername;" & _ "Pwd=myPassword" For more information, see: Connection String Format and Attributes To view Microsoft KB articles related to Microsoft ODBC for Oracle, click here ________________________________________ ODBC Driver for Oracle - from Oracle oConn.Open "Driver={Oracle ODBC Driver};" & _ "Dbq=myDBName;" & _ "Uid=myUsername;" & _ "Pwd=myPassword" Where: The DBQ name must be defined in the tnsnames.ora file For more information, see: Oracle8 ODBC Driver Help, Oracle ODBC FAQs, [asporacle] listserv FAQs, and ASPDB Oracle ________________________________________ ODBC Driver for Oracle Rdb oConn.Open "Driver={Oracle ODBC Driver for Rdb};" & _ "UID=myUserID;" & _ "PWD=myPassword;" & _ "SVR=aServerName;" & _ "XPT=2;" & _ "DATABASE=Attach 'filename disk:[dir1.dir2]rootfile';" & _ "CLS=aClassName;" & _ "DBA=W;" & _ "CSO=1;" & _ "TLL=aLibName;" & _ "TLO=0;" & _ "DSO=0;" & _ "PWV=secPassword" For connecting to a database over TCP/IP, not using a specific SQL/Services class: oConn.Open "Driver={Oracle ODBC Driver for Rdb};" & _ "UID=myUserID;" & _ "PWD=myPassword;" & _ "SVR=aServerName;" & _ "XPT=2;" & _ "DATABASE=Attach 'filename disk:[dir1.dir2]rootfile'" For connecting to a database over DECNET using a specific class, not using pre-attached connection: oConn.Open "Driver={Oracle ODBC Driver for Rdb};" & _ "UID=myUserID;" & _ "PWD=myPassword;" & _ "SVR=aServerName;" & _ "XPT=1;" & _ "DATABASE=Attach 'filename disk:[dir1.dir2]rootfile';" & _ "CLS=aClassName" For connecting to a database over TCP/IP through a class that uses pre-attached connections: oConn.Open "Driver={Oracle ODBC Driver for Rdb};" & _ "UID=myUserID;" & _ "PWD=myPassword;" & _ "SVR=aServerName;" & _ "XPT=2;" & _ "CLS=aClassName" For more information, see: Oracle ODBC Driver for Rdb ________________________________________ ODBC Driver for Paradox oConn.Open "Driver={Microsoft Paradox Driver (*.db )};" & _ "DriverID=538;" & _ "Fil=Paradox 5.X;" & _ "DefaultDir=c:\dbpath\;" & _ "Dbq=c:\dbpath\;" & _ "CollatingSequence=ASCII" Note: MDAC 2.1 (or greater) requires the Borland Database Engine (BDE) to update Paradox ISAM fDBF files. (Q230126). Note: There is an extra space after "db" in the Paradox Driver name ________________________________________ ODBC Driver for SQL Server For Standard Security oConn.Open "Driver={SQL Server};" & _ "Server=MyServerName;" & _ "Database=myDatabaseName;" & _ "Uid=myUsername;" & _ "Pwd=myPassword" For Trusted Connection security oConn.Open "Driver={SQL Server};" & _ "Server=MyServerName;" & _ "Database=myDatabaseName;" & _ "Uid=;" & _ "Pwd=" ' Or oConn.Open "Driver={SQL Server};" & _ "Server=MyServerName;" & _ "Database=myDatabaseName;" & _ "Trusted_Connection=yes" To Prompt user for username and password oConn.Properties("Prompt") = adPromptAlways oConn.Open "Driver={SQL Server};" & _ "Server=MyServerName;" & _ "DataBase=myDatabaseName" To connect to SQL Server running on the same computer oConn.Open "Driver={SQL Server};" & _ "Server=(local);" & _ "Database=myDatabaseName;" & _ "Uid=myUsername;" & _ "Pwd=myPassword" To connect to SQL Server running on a remote computer (via an IP address) oConn.Open "Driver={SQL Server};" & _ "Server=xxx.xxx.xxx.xxx;" & _ "Address=xxx.xxx.xxx.xxx,1433;" & _ "Network=DBMSSOCN;" & _ "Database=myDatabaseName;" & _ "Uid=myUsername;" & _ "Pwd=myPassword" Where: - xxx.xxx.xxx.xxx is an IP address - 1433 is the default port number for SQL Server. - "Network=DBMSSOCN" tells ODBC to use TCP/IP rather than Named Pipes (Q238949) ________________________________________ ODBC Driver for Sybase If using the Sybase System 12 (or 12.5) Enterprise Open Client ODBC Driver oConn.Open "Driver={SYBASE ASE ODBC Driver};" & _ "Srvr=myServerName;" & _ "Uid=myUsername;" & _ "Pwd=myPassword" If using the Sybase System 11 ODBC Driver oConn.Open "Driver={SYBASE SYSTEM 11};" & _ "Srvr=myServerName;" & _ "Uid=myUsername;" & _ "Pwd=myPassword" If using the Intersolv 3.10 Sybase ODBC Driver oConn.Open "Driver={INTERSOLV 3.10 32-BIT Sybase};" & _ "Srvr=myServerName;" & _ "Uid=myUsername;" & _ "Pwd=myPassword" ________________________________________ ODBC Driver for Sybase SQL Anywhere oConn.Open "ODBC; Driver=Sybase SQL Anywhere 5.0;" & _ "DefaultDir=c:\dbpath\;" & _ "Dbf=c:\sqlany50\mydb.db;" & _ "Uid=myUsername;" & _ "Pwd=myPassword;" & _ "Dsn=""""" Note: Including the DSN tag with a null string is absolutely critical or else you get the dreaded -7778 error. For more information, see: Sybase SQL Anywhere User Guide ________________________________________ ODBC Driver for Teradata oConn.Open "Provider=Teradata;" & _ "DBCName=MyDbcName;" & _ "Database=MyDatabaseName;" & _ "Uid=myUsername;" & _ "Pwd=myPassword" For more information, see Teradata ODBC Driver ________________________________________ ODBC Driver for Text oConn.Open _ "Driver={Microsoft Text Driver (*.txt; *.csv)};" & _ "Dbq=c:\somepath\;" & _ "Extensions=asc,csv,tab,txt" Then specify the filename in the SQL statement: oRs.Open "Select * From customer.csv", _ oConn, adOpenStatic, adLockReadOnly, adCmdText Note: If you are using a Tab delimited file, then make sure you create a schema.ini file, and include the "Format=TabDelimited" option. ________________________________________ ODBC Driver for Visual FoxPro With a database container oConn.Open "Driver={Microsoft Visual FoxPro Driver};" & _ "SourceType=DBC;" & _ "SourceDB=c:\somepath\mySourceDb.dbc;" & _ "Exclusive=No" Without a database container (Free Table Directory) oConn.Open "Driver={Microsoft Visual FoxPro Driver};" & _ "SourceType=DBF;" & _ "SourceDB=c:\somepath\mySourceDbFolder;" & _ "Exclusive=No" Koneksi String database Mysql Imports System Imports System.Data Imports MySql.Data.MySqlClient Public Class Form1 Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click Dim connString As String = "Database=Test;Data Source=localhost;User Id=root;Password=sa" Dim conn As New MySqlConnection(connString) Try conn.Open() Console.WriteLine("Connection Opened") Console.WriteLine("Connection Properties") Console.WriteLine("- ConnectionString : {0}", conn.ConnectionString) Console.WriteLine("- Database : {0}", conn.Database) Console.WriteLine("- DataSource : {0}", conn.DataSource) Console.WriteLine("- ServerVersion : {0}", conn.ServerVersion) Console.WriteLine("- State : {0}", conn.State) Catch ex As MySqlException ' Display error MessageBox.Show("Connection Error.") Console.WriteLine("Error: " & ex.ToString()) Finally ' Close Connection conn.Close() MessageBox.Show("Connection Success.") End Try End Sub End Class Setting Huruf di ComponentOne / C1ReportDesigner di VB.NET "{\b\fs20"+ field +" string } string" {\colortbl ;\red255\green0\blue0;}\cf1sasa \cf0 Membatasi Jumlah Berita per halaman <? //file news.php $page=$_GET[page]; $per=8; if(!isset($page)){ $page=0; } $offset=$page*$per; $sql=mysql_query("select * from news order by id desc limit $offset, $per"); while($rs=mysql_fetch_object($sql)){ ?> <b><u><?=$rs->judul;?></u></b> ( <span id="tanggal"><?=$rs->tgl;?></span> ) <br><br> <? $isiberita=htmlentities($rs->isi); $tmpbagianberita=array(); $tmp=explode("\n",$isiberita); for($i=0;$i<=3;$i++){ $tmpbagianberita[$i]=$tmp[$i]; } $bagianberita=implode("<br>",$tmpbagianberita); echo $bagianberita." <i>&nbsp;&nbsp;<a href='detailnews.php?id=$rs->id'>selengkapnya</a></i>"; echo "<br><br><hr>"; }?> HALAMAN <? $hasil=mysql_query("select * from news"); $jmlhalaman=ceil(mysql_num_rows($hasil)/$per); $jum=mysql_num_rows($hasil); if(!$jum==0){ echo""; for($a=1;$a<=$jmlhalaman;$a++) { $u=$a-1;?> | <a href=new.php?page=<?=$u;?>"><?=$a?></a> | <? } echo"<br>"; } ?> Print Pakai LX300 Option Explicit Private Type DOCINFO pDocName As String pOutputFile As String pDatatype As String End Type Private Declare Function ClosePrinter Lib "winspool.drv" (ByVal _ hPrinter As Long) As Long Private Declare Function EndDocPrinter Lib "winspool.drv" (ByVal _ hPrinter As Long) As Long Private Declare Function EndPagePrinter Lib "winspool.drv" (ByVal _ hPrinter As Long) As Long Private Declare Function OpenPrinter Lib "winspool.drv" Alias _ "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, _ ByVal pDefault As Long) As Long Private Declare Function StartDocPrinter Lib "winspool.drv" Alias _ "StartDocPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, _ pDocInfo As DOCINFO) As Long Private Declare Function StartPagePrinter Lib "winspool.drv" (ByVal _ hPrinter As Long) As Long Declare Function WritePrinter Lib "winspool.drv" (ByVal _ hPrinter As Long, pBuf As Any, ByVal cdBuf As Long, _ pcWritten As Long) As Long Public lhPrinter As Long Sub ClosePrintRedirect() Dim lReturn As Long lReturn = EndPagePrinter(lhPrinter) lReturn = EndDocPrinter(lhPrinter) lReturn = ClosePrinter(lhPrinter) End Sub Sub WriteToPrinter(sWrittenData As String, Optional WithBR As Boolean = False) Dim lReturn As Long Dim lpcWritten As Long sWrittenData = sWrittenData '& IIf(WithBR = True, vbCrLf, "") lReturn = WritePrinter(lhPrinter, ByVal sWrittenData, _ Len(sWrittenData), lpcWritten) End Sub Function LoadPrintRedirect(Optional DeviceName As String = "") As Boolean On Error GoTo salah Dim lReturn As Long Dim lDoc As Long Dim MyDocInfo As DOCINFO ClosePrintRedirect DeviceName = Printer.DeviceName lReturn = OpenPrinter(DeviceName, lhPrinter, 0) If lReturn = 0 Then Exit Function End If MyDocInfo.pDocName = "vbBego - Print Redirect" MyDocInfo.pOutputFile = vbNullString MyDocInfo.pDatatype = vbNullString lDoc = StartDocPrinter(lhPrinter, 1, MyDocInfo) Call StartPagePrinter(lhPrinter) LoadPrintRedirect = True Exit Function salah: End Function Function ConvertToChr(nstr As String) Dim myFormat As String, esc As String esc = Chr$(27) Dim h, i As Integer h = Split(nstr, " ") For i = 0 To UBound(h) myFormat = myFormat & Chr(h(i)) Next i ConvertToChr = myFormat End Function contoh: LoadPrintRedirect WriteToPrinter "Haloooooo" & vbCrLf ClosePrintRedirect Teks pada posisi tertentu <div style="position:absolute;top:200px;left:320px;z-index:-1">text</div>