Private Declare Function GetTempPathA Lib "kernel32" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Function GetTempPath() As String
Dim S As String
Dim i As Integer
i = GetTempPathA(0, "")
S = Space(i)
Call GetTempPathA(i, S)
GetTempPath = AddBackslash(Left$(S, i - 1))
End Function
Tuesday, July 22, 2008
Cari Temporary Folder
Cari Folder System
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Function WindowsDir() As String
Dim X As Long
Dim strPath As String
strPath = Space$(1024)
X = GetWindowsDirectory(strPath, Len(strPath))
strPath = Left$(strPath, X)
If Right$(strPath, 1) <> "\" Then strPath = strPath & "\"
WindowsDir = strPath
End Function
Monday, July 21, 2008
Copy file di ASP
<%
Dim fso, MyFile
Set fso = CreateObject("Scripting.FileSystemObject")
Set MyFile = fso.GetFile(Server.MapPath("data_arman.mdb"))
MyFile.Copy (Server.MapPath("backupofdata_armanmdb"))
%>
Fungsi Split di ASP
<% " "
Dim Test_Split, Data1, Test_Split2,Data2,Data3, Test_Split3, SisipTeks1,SisipTeks2
SisipTeks = " EDISI "
SisipTeks2 = date()
Data1 = "SKH KOMPAS ED. 16 - 30 NOVEMBER 2004"
Test_Split = split(Data1,"ED")
Data2 = "SKH. TRANSPARAN ED. NOVEMBER 2004"
Test_Split2 = split(Data2,"ED")
Data3 = "SKH SRIPO ED. NOVEMBER 2004"
Test_Split3 = split(Data3,"ED")
Response.Write Data1
Response.Write "
"
Response.Write "Sesudah di split hasilnya > "
Response.Write Test_Split(0)
Response.Write "
Response.Write Data2
Response.Write "
"
Response.Write "Sesudah di split hasilnya > "
Response.Write Test_Split2(0)
Response.Write "
Response.Write Data3
Response.Write "
"
Response.Write "Sesudah di split hasilnya > "
Response.Write Test_Split3(0)
Response.Write SisipTeks
Response.Write SisipTeks2
%>
Script Hapus di ASP
<%
Dim adoCon
Dim rsDeleteEntry
Dim strSQL
Dim Waktu1
Waktu1=Request.Form("Waktu")
Set adoCon = Server.CreateObject("ADODB.Connection")
adoCon.Open "DRIVER={Microsoft Access Driver (*.mdb)};uid=;pwd=password; DBQ=" & Server.MapPath("dunia_it_armansyah.mdb")
Set rsDeleteEntry = Server.CreateObject("ADODB.Recordset")
StrSql = "Select * from Tabel_tabelan Where Tabel_tabelan.waktunyo = '" & Waktu1 & "'"
rsDeleteEntry.LockType = 3
rsDeleteEntry.Open strSQL, adoCon
rsDeleteEntry.Delete
rsDeleteEntry.Close
Set rsDeleteEntry = Nothing
Set adoCon = Nothing
Response.Redirect "okebos.asp"
%>
Fungsi Tanggal di ASP
<%
Dim tg, mt, tn
tg = day(now)
mt = month(now)
tn = year(now)
Response.Write tg
Response.Write "
"
Response.Write mt
Response.Write "
"
Response.Write tn
%>
Contoh Fungsi Cdate
<%
Dim A, B, C
A = "18 April 2005"
B = Cdate(A)
C = b - 3
Response.Write B
Response.Write "
"
Response.Write C
%>
Script Hijriyah
var g, thistory, sDay, sMonth, sWeek, bora, month, day, year, ayear, cyear;
var aDay, aMonth, theYear, HDAY, HMONTH;
var myDay = new Array(7);
myDay[0] = "Sunday";
myDay[1] = "Monday";
myDay[2] = "Tuesday";
myDay[3] = "Wednesday";
myDay[4] = "Thursday";
myDay[5] = "Friday";
myDay[6] = "Saturday";
var myiDay = new Array(7);
myiDay[0] = "";
myiDay[1] = "";
myiDay[2] = "";
myiDay[3] = "";
myiDay[4] = "";
myiDay[5] = "Jummah";
myiDay[6] = "";
var sDate = new Date();
var sString;
var sYear;
g = 0;
thistory=1;
bora = "AD";
sString = sDate.toString();
sYear = parseInt(sString.substring(sString.length-4,sString.length));
/* Untuk merubah penanggalan Hijriah, tinggal ubah saja pada teks :
* sDay = sDate.getDate() - 1;
* Aslinya : sDay = sDate.getDate();
* Jika ada sesuatu yang lain, maka modifikasi saja bagian ini
*
*/
sDay = sDate.getDate()-1;
sMonth = sDate.getMonth() + 1;
sWeek = sDate.getDay();
function check()
{
day=sDay;
month=sMonth;
year=sYear;
var dday=g+day*1
ayear=year;
if (bora=="BC") {ayear=-year+1}
convert ()
}
function convert () {
var NOTE=''
var hijri=0;
var georgean=1;
if (georgean>0)
{
georgean=0;
var cdays=day*1;
cdays += (month>11) ?30 : 0;
cdays += (month>10) ?31 : 0;
cdays += (month>9) ? 30 : 0;
cdays += (month>8) ? 31 : 0;
cdays += (month>7) ? 31 : 0;
cdays += (month>6) ? 30 : 0;
cdays += (month>5) ? 31 : 0;
cdays += (month>4) ? 30 : 0;
cdays += (month>3) ? 31 : 0;
cdays += (month>2) ? 28 : 0;
cdays += (month>1) ? 31 : 0;
leap=0;cdays +=0;
if (ayear/4 == Math.floor(ayear/4)) {leap=1;}
if (ayear/100 == Math.floor(ayear/100)) {if (ayear/400 != Math.floor(ayear/400)) {leap=0;}}
if (leap==1) {if (month>2) {cdays +=1;}}
if (day>28+leap) {if (month==2) {kill ()}}
myear = ayear*1+cdays/(365+leap);
process1 ();
}
result();
}
function process1()
{
cyear=(myear-621.578082192)/0.97022298;
cyear += Math.floor(Math.abs(cyear)/3000)*30/10631
cday= cyear-Math.floor(cyear);
cyear -= cday;
if ((cday*10631/30)-Math.floor(cday*10631/30)<.5){cday= Math.floor(cday*10631/30) +1} else {cday= Math.floor(cday*10631/30) +2};
test2(cday)
mday=HDAY;cmonth=HMONTH;
if (cmonth==13){cmonth=1;cyear +=1};
var Precise=Pcision(JulianDay(ayear*1,month*1,day*1,19,30,0));
if (mday !=Precise) {if (mday==1 && Precise>28) {cmonth -=1;if (cmonth==0) {cmonth=12;cyear -=1}} else {if (mday>28 && Precise<3) cmonth="="13)" cmonth="1;cyear">
mday=Precise
if (cyear<1)>
}
function test2 (HdayN) {
var Monthf=29.53058796;
var Gyear=cyear*0.970224044+621.574981435;
var GyearDf= Gyear-Math.floor(Gyear);
Gyear -= GyearDf;
var l=0;
if (Gyear/4 == Math.floor(Gyear/4)) {l=1;} ;
if (Gyear/100 == Math.floor(Gyear/100)) {if (Gyear/400 != Math.floor(Gyear/400)) {l=0;}};
Gday =Math.floor((365+l)*GyearDf)+1;
Gyear +=Gday/(365+l);
var Hyear=(Gyear-621.574981435)/0.970224044;
var Hdayf=Hyear-Math.floor(Hyear),Hday=Hdayf*10631/30+1;
Hmonth=1;HdayF=1
while (HdayF
Hday +=1;HdayF +=1
if (Hday>= Monthf) {Hday=Hday-Monthf;Hmonth +=1};
}
HDAY=Math.floor(Hday)+1;HMONTH=Hmonth;
}
function Pcision(F)
{
var Status='ok';
var Dn=0;
var jDn=F;
if (Moon(jDn-1)<=0) {jDn -=1;Dn +=1}
while (Status=='ok')
{
var Fn=Moon(jDn);var Fn2=Moon(jDn-1);
if (((Fn/Math.abs(Fn))*(Fn2/Math.abs(Fn2)))==1)
{
Dn +=1;jDn -=1;
}
else
{
if (Math.abs(Fn*Fn2)<.2)
{
Status='End';
}
else
{
Dn +=1;jDn -=1;
}
}
}
return Dn;
}
function Moon(jd)
{
var T_ = (jd-EPOCH*1)/ 36525.0;
var mE=297.8502042
+ 445267.1115168*T_
- 0.0016300*(T_*T_)
+ (T_*T_*T_)/545868.0
- (T_*T_*T_*T_)/113065000
var mA=134.9634114
+ 477198.8676313*T_
+ 0.0089970*(T_*T_)
+ (T_*T_*T_)/69699.0
- (T_*T_*T_*T_)/863310000.0
var SmA=357.5291092
+ (35999.0502909*T_)
- (0.0001536 *T_*T_)
+ ((T_*T_*T_)/24490000)
var D = r(mE)*1;
var S = r(SmA)*1;
var M = r(mA)*1;
var phaseAngle=180-D-6.289*sin(M)+2.1*sin(S)-1.274*sin(r(2*D)-M)-0.658*sin(2*D);
phaseAngle +=-0.214*sin(2*M);
phaseAngle +=-0.110*sin(1*D)
/** k (46.1) **/
var iF=(1+cos(phaseAngle))/2*(phaseAngle/Math.abs(phaseAngle))
return iF
}
function rad(angle)
{return r(angle)*Math.PI/180}
function sin(angle)
{return Math.sin(rad(angle))}
function cos(angle)
{return Math.cos(rad(angle))}
function r(Input)
{if (Input >=0) {var Output=Input-Math.floor(Input/360)*360} else {var Output=Input-Math.ceil(Input/360)*360+360;}
return Output}
function JulianDay (gYear,gMonth,gDay,gHour,gMinutes,gSeconds)
{
var calendar='GREGORIAN'
EPOCH = 2451545.0;
if (gMonth <= 2) { --gYear;gMonth += 12;}
var A = Math.floor(gYear/100);
var B=0;
if (calendar == 'GREGORIAN') {B =Math.floor( 2 - A + (A / 4))} else {B = 0;}
var dayFraction = (gHour + gMinutes/60.0 + gSeconds/3600.0) / 24.0;
var dayAndTime = gDay + dayFraction;
jd_ =Math.floor(365.25 * (gYear + 4712))+Math.floor(30.6001 * (gMonth+1)) + dayAndTime + B -63.5;
return jd_*1;
}
function result()
{
if (thistory==1)
{
WeekDay ();
if (cyear<0) g="="0)" bora="BH" bora="BC" g="="0)" bora="AH" bora="AD">
yfinale=day+"/"+month+"/"+year+" ";
finale=mday+"/"+cmonth+"/"+Math.abs(cyear)+" ";
theYear = Math.abs(cyear);
thistory=0;
}
}
function WeekDay()
{
if (g==1) {var Dyear=cyear;var Dmonth=cmonth;var Dday=mday} else {var Dyear=year*1;var Dmonth=month*1;var Dday=day*1}
if (bora=="BC" || Dyear<0 dyear="-Math.abs(Dyear)+1}
var DayCount=0; var L=0
while (Dyear<10000){
if (Dyear/4==Math.floor(Dyear/4)) {L=1} else {L=0};
if (Dyear/100==Math.floor(Dyear/100)) { if (Dyear/400 !=Math.floor(Dyear/400)) {L=0}};
if (Dmonth==14) {DayCount +=365+L} else {
while (Dmonth<13)>
if (Dmonth==1 || Dmonth==3 || Dmonth==5 || Dmonth==7 || Dmonth==8 || Dmonth==10 || Dmonth==12) {var limit=31} else {var limit=30};
if (Dmonth==2) {limit=28+L}
if (Dday==40) {DayCount +=limit} else {while (Dday
Dday +=1;DayCount +=1;}};
Dmonth +=1;Dday=40}};
Dyear +=1; Dmonth=14};
var Dweek=DayCount%7;
if (Dweek==0) {DAY=" (Fri)"};
if (Dweek==6) {DAY=" (Sat)"};
if (Dweek==5) {DAY=" (Sun)"};
if (Dweek==4) {DAY=" (Mon)"};
if (Dweek==3) {DAY=" (Tue)"};
if (Dweek==2) {DAY=" (Wed)"};
if (Dweek==1) {DAY=" (Thu)"};
}
Grafik Pertumbuhan Order
<%
Const IMAGES_PATH = "images/"
Const WIDTH_YGRAF_IMAGE = 36
Const HEIGHT_YGRAF_IMAGE = 111
Const adStateOpen = &H00000001
Const adCmdTableDirect = &H0200
Dim oChart1, oChart2, oChart3, oChart4, oChart5, oChart6
Dim i, bSuccess
Dim m_oRs
Dim m_sConnectionString
Dim SQLTh2004, SQLTh2005, SQLTh2006
Dim m_arrTh2004, m_arrTh2005, m_arrTh2006
Dim m_arrData()
Dim m_arrLabels(), m_arrLabels2, m_arrLabels3
'Buat label bulan u/. diletakkan pada bagian bawah grafik
m_arrLabels2 = Array("Jan", "Peb", "Mar", "Apr", "Mei", "Jun", "Jul", "Agu", "Sep", "Okt", "Nop", "Des")
m_arrLabels3 = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12)
'Buat koneksi kedalam database
m_sConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & Server.MapPath("Dtbs/Mdb09/tumbuhkembangOrder.mdb")
'Inisialisasi SQL
SQLTh2004 = "SELECT Th2004 FROM Table_Grafik_Pertumbuhan_Order"
SQLTh2005 = "SELECT Th2005 FROM Table_Grafik_Pertumbuhan_Order"
SQLTh2006 = "SELECT Th2006 FROM Table_Grafik_Pertumbuhan_Order"
'Buat RecordSet
Set m_oRs = Server.CreateObject("ADODB.Recordset")
' Ambil 3 field dari database dengan metode GetRows
' Penambahan field bisa dilakukan dengan merubah juga file : grafiknya.asp & cMultipleVerticalChart.asp
m_arrTh2004 = GetRows(SQLTh2004)
m_arrTh2005 = GetRows(SQLTh2005)
m_arrTh2006 = GetRows(SQLTh2006)
'Tutup koneksi kedatabase
m_oRs.Close
Set m_oRs = Nothing
'Panggil data
Call LoadFakeData
'Inisialisasi data untuk label
For i = 0 To UBound(m_arrData)
Redim Preserve m_arrLabels(i)
m_arrLabels(i) = i + 1
Next
'--- Mulai pembentukan grafik
Set oChart2 = New cMultipleVerticalChart
With oChart2
.ChartTitle = " Pertumbuhan Order 2004 - 2006"
.FooterText = " Catatan : Klik Update Grafik u/. menampilkan grafik terbaru"
.TableCaption = "Tabel Pertumbuhan Order"
.BarWidth = 12
.TotalsMode = 2
.DisplayYGrafImage = IMAGES_PATH & "y100.gif"
.AddBarImages = Array(IMAGES_PATH & "1x1_B0C4DD.gif", IMAGES_PATH & "1x1_FFC19F.gif", IMAGES_PATH & "1x1_CC9A7F.gif")
.AddLegendText = Array("2004", "2005", "2006")
If Not .AddData(m_arrTh2004) Then Response.Write "Pesan Kesalahan : " & .ErrorMessage
If Not .AddData(m_arrTh2005) Then Response.Write "Pesan Kesalahan : " & .ErrorMessage
If Not .AddData(m_arrTh2006) Then Response.Write "Pesan Kesalahan : " & .ErrorMessage
If Not .AddLabels(m_arrLabels2) Then Response.Write "Pesan Kesalahan : " & .ErrorMessage
If Not .CreateChart Then Response.Write "Pesan Kesalahan : " & .ErrorMessage
End With
Set oChart2 = Nothing
If Err Then Response.Write "
Kode Kesalahan = " & Err.Number & "
" & Err.Description
%>
Hitung jumlah record di ASP
'-------------- Hitung Jumlah data/Records yang di-isi hari ini saja
Dim adoCon_Hari_ini
Set adoCon_Hari_ini = Server.CreateObject("ADODB.Connection")
adoCon_Hari_ini.Open "DRIVER={Microsoft Access Driver (*.mdb)};uid=;pwd=dunia_it_armansyah;DBQ=" & Server.MapPath("ordermarket.mdb")
Dim rsOEFToday
Set rsOEFToday = Server.CreateObject("ADODB.Recordset")
'---------- Tentukan dulu variabel Tanggal, Bulan, Tahun ----
Dim Tanggal
Dim Bulan
Dim Tahun
Bulan = Month(date())
Tanggal = Day(date())
Tahun = "1999"
'Bisa diganti > Tahun = year(now)
Dim SQLOEFToday
SQLOEFTODAY = "Select * from Tabel1" & _
"Where ((day(WaktuPengisian)= " &Tanggal & ") And " & _
"(month(WaktuPengisian)= " &Bulan & ") And " & _
"(Year(WaktuPengisian)= " &Tahun & "))"
rsOEFToday.Open SQLOEFToday, adoCon_Hari_ini, adOpenStatic
Dim TotalOEFToday
TotalOEFToday = rsOEFToday.recordcount
Script Penyimpangan
'#######################################################################################
'------- Mulai Buat Perhitungan Penyimpangan Order ---
'--------------------------------------------------------------------
'---------- Diprogram oleh Armansyah, S.Kom; Sabtu, 09 Agustus 2003 ------
'--------------------------------------------------------------------
'#######################################################################################
'--- Cari Total Penyimpangan --
Dim SQL_TotalSemuaPenyimpangan
SQL_TotalSemuaPenyimpangan = "Select * from Tabel_Penyimpangan2"
RecordSet_OEF.Open SQL_TotalSemuaPenyimpangan, ActiveXDataObject_Connection, adOpenStatic
Dim Total_Semua_Penyimpangan
Total_Semua_Penyimpangan = RecordSet_OEF.recordcount
RecordSet_OEF.Close
'--- Cari Total Penyimpangan Bulan 1 --
Dim SQL_TotalSemuaPenyimpangan1
SQL_TotalSemuaPenyimpangan1 = "Select * from Tabel_Penyimpangan2 " & _
"Where ((month(JamAsli)= " & "1" & ") And " & _
"(Year(JamAsli)= " &Tahun & "))"
RecordSet_OEF.Open SQL_TotalSemuaPenyimpangan1, ActiveXDataObject_Connection, adOpenStatic
Buat Prosen dan Statistik
'--------------------------------------------------------------------
'---------- Fungsi Penghitungan Persentase dan Gambar Statistik -----
'---------- Diprogram oleh Armansyah, S.Kom; Rabu 18 Juni 2003 ------
'--------------------------------------------------------------------
Dim PanjangGambar1
Dim PanjangGambar2
Dim PanjangGambar3
Dim PanjangGambar4
Dim TotalPersen
Dim Total
Total = Total_Semua_OEFSELESAI + Total_Semua_OEFBLMSELESAI + Total_Semua_OEFBatal
Function HitungPersen(Angka)
TotalPersen = (angka/total) * 100
TotalPersen = Cint(TotalPersen)
HitungPersen = TotalPersen
End Function
Function Gambar1(x)
PanjangGambar1 = (x*2)
Gambar1 = PanjangGambar1
End Function
Function Gambar2(y)
PanjangGambar2 = (y*2)
Gambar2 = PanjangGambar2
End Function
Function Gambar3(z)
PanjangGambar3 = (z*2)
Gambar3 = PanjangGambar3
End Function
Function Gambar4(Arman_Mita)
PanjangGambar4 = (Arman_Mita*2)
Gambar4 = PanjangGambar4
End Function
Contoh Query Database di ASP
<%
'--------------------------------------------------------------------
'File ini bernama : persen_order_2_2006.asp
'Tanggal Pembuatan : Rabu, 18 Juni 2003 Pkl. 15:22
' Programmer : Armansyah, S.Kom
'armansyah.skom@gmail.com / dunia-it-armansyah.blogspot.com / armansyah.swaramuslim.com
'--------------------------------------------------------------------
'-------------- Hitung Jumlah Semua data/Records yang ada ditabel OEF
Dim ActiveXDataObject_Connection
set ActiveXDataObject_Connection = Server.CreateObject("ADODB.Connection")
ActiveXDataObject_Connection.Open "DRIVER={Microsoft Access Driver (*.mdb)};uid=;pwd=akulahthebestcoy;DBQ=" & Server.MapPath("databasenyo.mdb")
Dim RecordSet_OEF
Set RecordSet_OEF = Server.CreateObject("ADODB.Recordset")
Dim SQL_TotalSemuaOef
SQL_TotalSemuaOef = "Select * from Tabel1"
RecordSet_OEF.Open SQL_TotalSemuaOef, ActiveXDataObject_Connection, adOpenStatic
Dim Total_Semua_OEF
Total_Semua_OEF = RecordSet_OEF.recordcount
RecordSet_OEF.Close
'-------------- Hitung Jumlah data/Records yang sudah selesai proses
Dim SQL_Order_Selesai
SQL_Order_Selesai = "Select * from Tabel1 Where Tabel1.StatusOrder = 'SUDAH SELESAI'"
RecordSet_OEF.Open SQL_Order_Selesai, ActiveXDataObject_Connection, adOpenStatic
Dim Total_Semua_OEFSELESAI
Total_Semua_OEFSELESAI = RecordSet_OEF.recordcount
RecordSet_OEF.Close
'-------------- Hitung Jumlah data/Records yang belum selesai proses
Dim SQL_Order_Blm_Selesai
SQL_Order_Blm_Selesai = "Select * from Tabel1 Where Tabel1.StatusOrder <> 'SUDAH SELESAI'"
RecordSet_OEF.Open SQL_Order_Blm_Selesai, ActiveXDataObject_Connection, adOpenStatic
Dim Total_Semua_OEFBLMSELESAI
Total_Semua_OEFBLMSELESAI = RecordSet_OEF.recordcount
RecordSet_OEF.Close
'-------------- Hitung Jumlah data/Records yang batal oiy
Dim SQL_Order_yang_batal
SQL_Order_yang_batal = "Select * from Tabel1 Where Tabel1.StatusOrder = 'BATAL'"
RecordSet_OEF.Open SQL_Order_yang_batal, ActiveXDataObject_Connection, adOpenStatic
Dim Total_Semua_OEFBatal
Total_Semua_OEFBatal = RecordSet_OEF.recordcount
RecordSet_OEF.Close
%>
Buat file Log di VB6
Dim lpBuff As String * 25
Dim ret As Long ', username As String
Dim namauser As String
Dim GetCurrentUser As String
ret = GetUserName(lpBuff, 25)
GetCurrentUser = Left(lpBuff, InStr(lpBuff, Chr(0)) - 1)
computer_name = Space$(256)
length = Len(computer_name)
GetComputerName computer_name, length
computer_name = Left$(computer_name, length)
Dim fsoLog As New FileSystemObject
Dim oTS As TextStream
Dim PesanLog As Integer
Dim Teksnya, Teksnya2, Teksnya3 As String
Teksnya = GetCurrentUser
Teksnya2 = computer_name
Dim WaktuSekarang
Dim FormatWaktuSekarang
WaktuSekarang = Now()
FormatWaktuSekarang = FormatDateTime(WaktuSekarang, 3)
Teksnya3 = FormatTanggal(Now()) & " " & FormatWaktuSekarang
Dim CekFolderFileLog As String
Dim CekFileLog As String
CekFolderFileLog = App.Path
If Right$(CekFolderFileLog, 1) <> "\" Then CekFolderFileLog = CekFolderFileLog & "\Log"
If Not FileExist(CekFolderFileLog) Then
fsoLog.CreateFolder "Log"
End If
CekFolderFileLog = CekFolderFileLog & "\" & "PC-BLKM.Arman"
If Not FileExist(CekFolderFileLog) Then
Set oTS = fsoLog.OpenTextFile(CekFolderFileLog, ForWriting, True)
oTS.WriteLine "#######################################"
oTS.WriteLine "NAMA FILE : PC-BLKM.Arman "
oTS.WriteLine "Dibuat Otomatis saat PC-BLKM diakses "
oTS.WriteLine ""
oTS.WriteLine "Nama User merujuk pada login user pada Windows"
oTS.WriteLine "ID Komputer : Mengacu pada ID System "
oTS.WriteLine "Diprogram oleh : armansyah@gmail.com "
oTS.WriteLine ""
oTS.WriteLine "#######################################"
oTS.WriteLine ""
oTS.Write "Waktu Login : "
oTS.WriteLine Teksnya3
oTS.Write "Nama User yang login : "
oTS.Write Teksnya
oTS.WriteLine ""
oTS.Write "Id Komputer : "
oTS.Write Teksnya2
oTS.WriteLine ""
oTS.Write "Total PC-BLKM dijalankan : "
oTS.WriteLine Format$(RunTimes) & " Kali"
oTS.WriteLine "-------------------------------------------"
oTS.Close
Set oTS = Nothing
Else
Set oTS = fsoLog.OpenTextFile(CekFolderFileLog, ForAppending, True)
oTS.WriteLine ""
oTS.Write "Waktu Login : "
oTS.WriteLine Teksnya3
oTS.Write "Nama User yang login : "
oTS.Write Teksnya
oTS.WriteLine ""
oTS.Write "Id Komputer : "
oTS.Write Teksnya2
oTS.WriteLine ""
oTS.Write "Total PC-BLKM dijalankan : "
oTS.WriteLine Format$(RunTimes) & " Kali"
oTS.WriteLine "-------------------------------------------"
oTS.Close
Set oTS = Nothing
End If
Batasan Input Password
Private Sub Command1_Click()
Dim flag As Boolean
Dim xText
Dim myconn As ADODB.Connection
Dim myrs As ADODB.Recordset
Dim mydb_file As String
Dim mysqlnya As String
' Get the data.
mydb_file = App.path
If Right$(mydb_file, 1) <> "\" Then mydb_file = mydb_file & "\Database\"
mydb_file = mydb_file & "db_login.mdb"
' Open a connection.
Set myconn = New ADODB.Connection
myconn.ConnectionString = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & mydb_file & ";" & _
"Persist Security Info=False"
myconn.Open
mysqlnya = "SELECT * FROM Tabel_Armansyah"
Set myrs = myconn.Execute(mysqlnya, , adCmdText)
flag = False
If txtPassword.Text = "" Then
MsgBox "Password tidak boleh kosong !!", vbOKOnly + vbCritical, _
"Peringatan : Anda belum memasukkan password "
txtPassword.SetFocus
flag = True
End If
Dim EnPas As String
EnPas = Encrypt(txtPassword.Text)
If Combo1.ListIndex = 0 Then
If Combo1 = myrs![UserName] And EnPas = myrs![Password] Then
Unload Me
flag = True
gblnPriv = True
'MDIForm1.Show
frmprogressbar.Show
End If
Else
myrs.MoveNext
If Combo1 = myrs![UserName] And EnPas = myrs![Password] Then
Unload Me
flag = True
gblnPriv = False
frmprogressbar.Show
End If
myrs.MoveFirst
End If
If flag = False Then
hitungan = hitungan + 1
If hitungan = 4 Then
End
Else
xText = "Sisa kesempatan anda hanya " + Str(4 - hitungan) + " x lagi"
If hitungan = 3 Then
xText = "Sekali ini merupakan kesempatan anda yang terakhir !!"
End If
MsgBox " Password Salah ... Akses ditolak!!" & vbCrLf & _
xText, vbOKOnly + vbCritical, "Peringatan : Terjadi kesalahan"
txtPassword.Text = ""
End If
End If
End Sub
RTF di VB6
Memanggil file rtf dari VB6 :
Private Sub Form_Load()
RichTextBox1.LoadFile "Armansyah.rtf"
End Sub
Memeriksa Kapasitas file di VB6
Memeriksa ukuran/kapasitas sebuah file :
Dim lSize As Long
Dim lSizeOnDisk As Long
Dim sPath As String
sPath = App.Path & "\Arman.exe"
lSize = GetFileSize(sPath)
lSizeOnDisk = GetSizeOnDisk(sPath)
labelku.Caption = sPath
If lSize <> 2008 Then
Dim Jawablah As Integer
Jawablah = MsgBox("Arman.exe rusak/hilang/berubah ! program tidak bisa dilanjutkan ...", _
vbQuestion + vbYes, "Error!")
Unload Me
End If
Tambah-tambahan di VB6
Private Sub Command1_Click()
Dim a, b, c, d, e As Double
a = Val(Text1.Text)
b = Val(Text2.Text)
c = Val(Text2.Text)
d = (a + b + c) * 100
e = (a + b + c)
Text5.Text = e
Text4.Text = d
End Sub
Tebak-tebakan di Pascal
program tebak;
uses crt;
var
acak,jawaban:integer;
tombol:char;
begin
repeat
clrscr;
writeln('Permainan menebak Angka');
writeln('Saya akan membangkitkan bilangan acak');
writeln('Antara 1 sampai dengan 4');
repeat
acak:=random(5);
until acak<>0;
writeln('Sekarang cobalah untuk menebak');
write('Angka berapa? ');
readln(jawaban);
if acak=jawaban then writeln('Selamat ! Jawaban Anda benar')
else
writeln('Belum benar tuh jawabannya = ',acak);
writeln;
writeln('tekan t untuk mengakhiri');
writeln('Atau tombol lain untuk mengulangi');
Tombol:=readkey;
until(tombol='T') or (tombol='t')
end.
Cari Data di Pascal
Program CariData;
{Contoh Pencarian data pada Array}
Uses crt;
Type
String15=string[15];
Const
Jum_Elemen=10;
NamaKota:Array[1..Jum_Elemen] Of String15
=('PALEMBANG','MEDAN','PADANG','JAMBI','JAKARTA',
'SURABAYA','SEMARANG','YOGYAKARTA','BANDUNG',
'SOLO','KALIMANTAN','SULAWESI');
Merekam Data di Pascal
Program fteks2;
{Contoh merekam sejumlah karakter ke file teks}
Uses crt;
Var
Fhuruf:text;
Begin
clrscr;
Writeln('Merekam ke file teks');
Assign(fhuruf,'HURUF2.TXT');
Rewrite(fhuruf); {Menciptakan File}
Writeln(fhuruf,'A');
Writeln(fhuruf,'B');
Writeln(fhuruf,'C');
Close(fhuruf);
write('Selesai. Tekan enter.');
Readln;
End.
Cari Bulan dalam Pascal
Program Bulan;
Var
KodeBulan:Integer;
Begin
write('Kode Bulan [1 s/d 12]=');
readln(kodebulan);
case kodebulan of
1,3,5,7,8,10,12: writeln('Jumlah Hari = 31');
4,6,9,11: writeln('Jumlah Hari =30');
2: writeln('Jumlah hari =28 atau 29');
else
writeln('Salah Memasukkan Kode Bulan');
end;readln;
end.
Subscribe to:
Posts (Atom)
