DAFTAR PUSTAKA

Fathansyah. Basis Data. Bandung: Informatika Bandung, 2007. Fowler, Martin. UML Distilled Ed.3. Terjemahan: Tim Penerjemah Penerbit ANDI. Yogyakarta: ANDI, 2005. Munawar. Pemodelan Visual Dengan UML. Yogyakarta: Ghara Ilmu, 2005. Prasetia, Retna dan Catur Edi Widodo. Teori dan Praktek Interfacing Port Paralel dan Port Serial Komputer dengan Visual Basic 6.0. Yogyakarta: ANDI, 2004. Pressman, Roger S., Rekayasa Perangkat Lunak: Pendekatan Praktisi (Buku 1) Ed. 2. Terjemahan: LN Harnaningrum. Yogyakarta: ANDI, 2002. Reksohadiprodjo, Sukanto dkk. Pengantar Ekonomi Perusahaan Buku 2 Ed.3. Yogyakarta: BPFE-Yogyakarta, 1990. Sommerville, Ian. Software Engineering Ed.6. Terjemahan: Yuhilza Hanum. Jakarta: Erlangga, 2003. Anonymous, Inpout32.dll for Windows 98/2000/NT/XP [online], available: http://logix4u.net/Legacy_Ports/Parallel_Port/Inpout32.dll_for_Windows_ 98/2000/NT/XP.html [13 November 2010] Anonymous, SMD [online], available: http://www.reme.cz/smt_en.html [8 Februari 2011] Pusat Bahasa Departemen Pendidikan Nasional, Kamus Besar Bahasa Indonesia [online], available: http://pusatbahasa.diknas.go.id/kbbi/index.php [8 Februari 2011]

64

LAMPIRAN

1. Listing program Module1 Public Declare Function Inp Lib "inpout32.dll" Alias "Inp32" _ (ByVal PortAddress As Integer) _ As Integer Public Declare Sub Out Lib "inpout32.dll" Alias "Out32" _ (ByVal PortAddress As Integer, _ ByVal Value As Integer) Public Public Public Public Public Public Public

rsCon As New ADODB.Connection rsTeknisi As New ADODB.Recordset rsData As New ADODB.Recordset rsReport As New ADODB.Recordset rsErr As New ADODB.Recordset rsMesin As New ADODB.Recordset rsLine As New ADODB.Recordset

2. Listing program frmMain (form utama) Option Explicit Dim isi As String Dim intNum As Integer Private Sub cmdCari_Click() 'mencari data untuk ditampilkan berdasarkan kriteria Me.MousePointer = 11 Dim strSQL As String Set Me.DataGrid2.DataSource = Nothing If Me.cmbVErr = "-" And Me.cmbVKategori = "-" _ And Me.cmbVMesin = "-" And Me.cmbVSebab = "-" And Me.cmbVTeknisi = "-" Then strSQL = "select * from tblPanggilan" Else strSQL = "select * from tblPanggilan where" If Me.cmbVErr "-" Then strSQL = strSQL & " error='" & Me.cmbVErr & "' and" If Me.cmbVKategori "-" Then strSQL = strSQL & " kategori='" & Me.cmbVKategori & "' and" If Me.cmbVMesin "-" Then strSQL = strSQL & " mesin='" & Me.cmbVMesin & "' and" If Me.cmbVSebab "-" Then strSQL = strSQL & " cause='" & Me.cmbVSebab & "' and" If Me.cmbVTeknisi "-" Then strSQL = strSQL & " nik_tek='" & Me.cmbVTeknisi & "' and" strSQL = Mid(strSQL, 1, Len(strSQL) - 3) End If If CBool(rsReport.State And adStateOpen) = True Then rsReport.Close rsReport.CursorLocation = adUseClient rsReport.Open strSQL, rsCon, adOpenStatic, adLockOptimistic Set Me.DataGrid2.DataSource = rsReport Me.MousePointer = 0 End Sub Private Sub cmdPreview_Click() If CBool(rsReport.State And adStateOpen) = True Then Set Report1.DataSource = rsReport Report1.Show 1 Else MsgBox "silakan cari data terlebih dulu", vbOKOnly + vbExclamation, "Perhatian" End If End Sub Private Sub cmdSimpanDB_Click() With rsData

65

66

!kategori = Me.cmbKategori !cause = Me.cmbCause !Action = Me.txtAction !mesin = Me.cmbMesin !Error = Me.txtErr !nik_tek = Me.cmbTeknisi !result = Me.cmbResult End With rsData.Update MsgBox "Tersimpan !", vbOKOnly + vbInformation, "Informasi" End Sub Sub lineTrouble(strLine As String) 'panggilan pada suatu line Dim i, tek rsLine.MoveFirst Do While Not rsLine.EOF If rsLine!kd_line = strLine Then tek = rsLine!nik_tek rsLine.MoveNext Loop rsTeknisi.MoveFirst Do While Not rsTeknisi.EOF If rsTeknisi!nik_tek = tek Then tek = rsTeknisi!nama_tek rsTeknisi.MoveNext Loop Dim ada As Boolean ada = False For i = 0 To Me.MSFlexGrid1.Rows - 1 If Me.MSFlexGrid1.TextMatrix(i, 0) = strLine Then ada Next i If ada = False Then Me.MSFlexGrid1.TextMatrix(Me.MSFlexGrid1.Rows - 1, 0) Me.MSFlexGrid1.TextMatrix(Me.MSFlexGrid1.Rows - 1, 1) Me.MSFlexGrid1.TextMatrix(Me.MSFlexGrid1.Rows - 1, 2) Me.MSFlexGrid1.AddItem "" intNum = Me.MSFlexGrid1.Rows - 1 Call putarSuara End If End Sub

= True

= strLine = 1 = tek

Sub lineTroubleFinish(strLine As String) 'panggilan pada suatu line telah selesai Dim n, strBulan, strTgl If Len(Month(Now)) = 2 Then strBulan = Month(Now) Else strBulan = "0" & Month(Now) If Len(Day(Now)) = 2 Then strTgl = Day(Now) Else strTgl = "0" & Day(Now) If Me.MSFlexGrid1.TextMatrix(0, 0) "" Then For n = 0 To Me.MSFlexGrid1.Rows - 2 If Me.MSFlexGrid1.TextMatrix(n, 0) = strLine Then With rsData .AddNew !kode = strTgl & strBulan & Year(Now) & FormatDateTime(TimeValue(Now), vbShortTime) & Me.MSFlexGrid1.TextMatrix(n, 0) !dt = Me.MSFlexGrid1.TextMatrix(n, 1) !nik_tek = "" .Update End With Me.MSFlexGrid1.RemoveItem (n) End If Next n Call ambilData End If End Sub

Private Sub Command5_Click() End End Sub Private Sub Form_Initialize()

67

Me.Top = 0 Me.Left = 0 End Sub Private Sub DTPicker1_Change() Call refreshDB End Sub Private Sub Form_Load() Me.ShockwaveFlash1.Movie = App.Path & "\mov.swf" rsCon.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\myTA.mdb;Persist Security Info=False" rsData.CursorLocation = adUseClient rsData.Open "select * from tblPanggilan", rsCon, adOpenStatic, adLockOptimistic Set Me.DataGrid1.DataSource = rsData

rsTeknisi.CursorLocation = adUseClient rsTeknisi.Open "select * from tblTeknisi", rsCon, adOpenStatic, adLockOptimistic rsTeknisi.MoveFirst Do While Not rsTeknisi.EOF If rsTeknisi!nik_tek "" Then Me.cmbTeknisi.AddItem rsTeknisi!nik_tek Me.cmbVTeknisi.AddItem rsTeknisi!nik_tek End If rsTeknisi.MoveNext Loop rsErr.CursorLocation = adUseClient rsErr.Open "select error from tblPanggilan", rsCon, adOpenStatic, adLockOptimistic rsErr.MoveFirst Do While Not rsErr.EOF If rsErr!Error "" Then Me.cmbVErr.AddItem rsErr!Error End If rsErr.MoveNext Loop rsMesin.CursorLocation = adUseClient rsMesin.Open "select mesin from tblPanggilan", rsCon, adOpenStatic, adLockOptimistic rsMesin.MoveFirst Do While Not rsMesin.EOF If rsMesin!mesin "" Then Me.cmbMesin.AddItem rsMesin!mesin Me.cmbVMesin.AddItem rsMesin!mesin End If rsMesin.MoveNext Loop

rsLine.CursorLocation = adUseClient rsLine.Open "select * from tblLine", rsLine.MoveFirst Do While Not rsLine.EOF If rsLine!kd_line "" Then frmSetting.cmbLineS3.AddItem frmSetting.cmbLineS4.AddItem frmSetting.cmbLineS5.AddItem frmSetting.cmbLineS6.AddItem frmSetting.cmbLineS7.AddItem End If rsLine.MoveNext Loop Call loadDB Call ambilData

rsCon, adOpenStatic, adLockOptimistic

rsLine!kd_line rsLine!kd_line rsLine!kd_line rsLine!kd_line rsLine!kd_line

68

End Sub Sub loadDB() If rsData.RecordCount > 0 Then If rsData!kode "" Then Me.txtTgl = Left(rsData!kode, 2) Me.txtBulan = Mid(rsData!kode, 3, 2) Me.txtTahun = Mid(rsData!kode, 5, 4) Me.txtJam = Mid(rsData!kode, 9, 5) Me.txtLine = Mid(rsData!kode, 14) Else Me.txtTgl = "" Me.txtBulan = "" Me.txtTahun = "" Me.txtJam = "" Me.txtLine = "" End If If rsData!dt "" Then Me.txtDown = rsData!dt Else Me.txtDown = "" If rsData!Action "" Then Me.txtAction = rsData!Action Else Me.txtAction = "" If rsData!Error "" Then Me.txtErr = rsData!Error Else Me.txtErr = "" If rsData!mesin "" Then Me.cmbMesin = rsData!mesin Else Me.cmbMesin = "" If rsData!result "" Then Me.cmbResult = rsData!result Else Me.cmbResult = "" If rsData!kategori "" Then Me.cmbKategori = rsData!kategori Else Me.cmbKategori = "" If rsData!cause "" Then Me.cmbCause = rsData!cause Else Me.cmbCause = "" If rsData!nik_tek "" Then Me.cmbTeknisi = rsData!nik_tek Else Me.cmbTeknisi = "" Me.lblDB.Caption = rsData.AbsolutePosition & " / " & rsData.RecordCount Else Me.txtTgl = "" Me.txtBulan = "" Me.txtJam = "" Me.txtLine = "" Me.txtTahun = "" Me.txtDown = "" Me.txtAction = "" Me.txtErr = "" Me.cmbMesin = "" Me.cmbResult = "" Me.cmbCause = "" Me.cmbKategori = "" Me.cmbTeknisi = "" Me.lblDB.Caption = "no record" End If End Sub Private Sub Image1_DblClick() frmMonitoring.Left = 0 frmInput.Left = frmMonitoring.Left + frmMonitoring.Width End Sub Private Sub imgBanner_DblClick() frmInput.Left = 0 frmMonitoring.Left = frmInput.Left + frmInput.Width End Sub Private Sub lblSetting_Click() frmPassword.Show 1 End Sub

Private Sub optBelumIsi_Click() Call refreshDB End Sub Private Sub optSemua_Click() Call refreshDB End Sub

69

Private Sub tmrChkPort_Timer() Dim strTemp, n, bin strTemp = Inp(frmSetting.txt1P.Text) Me.Label20.Caption = strTemp 'merubah desimal ke biner bin = strTemp Mod 2 n = strTemp \ 2 Do While n 0 bin = (n Mod 2) & bin n = n \ 2 Loop 'menggenapkan jadi 8 digit biner Do While Len(bin) < 8 bin = "0" & bin Loop 'membaca status 5 digit awal If Mid(bin, 1, 1) = 1 Then Call lineTrouble(frmSetting.cmbLineS6) Else Call lineTroubleFinish(frmSetting.cmbLineS6) End If If Mid(bin, 2, 1) = 0 Then Call lineTrouble(frmSetting.cmbLineS7) Else Call lineTroubleFinish(frmSetting.cmbLineS7) End If If Mid(bin, 3, 1) = 0 Then Call lineTrouble(frmSetting.cmbLineS5) Else Call lineTroubleFinish(frmSetting.cmbLineS5) End If If Mid(bin, 4, 1) = 0 Then Call lineTrouble(frmSetting.cmbLineS4) Else Call lineTroubleFinish(frmSetting.cmbLineS4) End If If Mid(bin, 5, 1) = 0 Then Call lineTrouble(frmSetting.cmbLineS3) Else Call lineTroubleFinish(frmSetting.cmbLineS3) End If '------- menampilkan line yang sedang error If intNum >= Me.MSFlexGrid1.Rows - 1 Then intNum = 0 If Me.MSFlexGrid1.Rows > 1 Then Me.frmLine.Visible = True Me.frmNoErr.Visible = False Me.lblLine.Caption = Me.MSFlexGrid1.TextMatrix(intNum, 0) Me.lblTime.Caption = Me.MSFlexGrid1.TextMatrix(intNum, 1) Me.lblTeknisi.Caption = Me.MSFlexGrid1.TextMatrix(intNum, 2) Else Me.frmLine.Visible = False Me.frmNoErr.Visible = True End If intNum = intNum + 1 End Sub Private Sub tmrInfo_Timer() 'menampilkan teks berjalan If Me.lblInfo.Left > (0 - Me.lblInfo.Width) Then Me.lblInfo.Left = Me.lblInfo.Left - 200 Else Me.lblInfo.Left = Me.Width / 2 End If End Sub Private Sub cmdFirst_Click() If rsData.RecordCount = 0 Then Exit Sub rsData.MoveFirst Call loadDB End Sub Private Sub cmdLast_Click() If rsData.RecordCount = 0 Then Exit Sub

70

rsData.MoveLast Call loadDB End Sub Private Sub cmdNext_Click() If rsData.RecordCount = 0 Then Exit Sub If rsData.AbsolutePosition < rsData.RecordCount Then rsData.MoveNext Call loadDB End Sub Private Sub cmdPrev_Click() If rsData.RecordCount = 0 Then Exit Sub If rsData.AbsolutePosition > 1 Then rsData.MovePrevious Call loadDB End Sub Private Sub DataGrid1_Click() Call loadDB End Sub Sub refreshDB() If CBool(rsData.State And adStateOpen) = True Then rsData.Close If Me.optSemua = True Then rsData.Open "select * from tblPanggilan", rsCon, adOpenStatic, adLockOptimistic ElseIf Me.optBelumIsi = True Then rsData.Open "select * from tblPanggilan where nik_tek=''", rsCon, adOpenStatic, adLockOptimistic End If Set Me.DataGrid1.DataSource = rsData Call loadDB End Sub Sub putarSuara() 'idikator suara saat ada error On Error GoTo bypass Me.MediaPlayer1.FileName = frmSetting.txtFileSuara Me.MediaPlayer1.PlayCount = frmSetting.txtSuaraLoop.Text Me.MediaPlayer1.Play bypass: Exit Sub End Sub Private Sub tmrMenit_Timer() 'me-refresh data yang ditampilkan Call refreshDB Call ambilData 'menambah lama error line sebanyak 1 menit Dim n For n = 0 To Me.MSFlexGrid1.Rows - 2 Me.MSFlexGrid1.TextMatrix(n, 1) = Me.MSFlexGrid1.TextMatrix(n, 1) + 1 Next n End Sub Sub ambilData() Dim rsAmbil As New ADODB.Recordset Dim strBulan As String Dim strTgl As String If Len(Month(Now)) = 2 Then strBulan = Month(Now) Else strBulan = "0" & Month(Now) If Len(Day(Now)) = 2 Then strTgl = Day(Now) Else strTgl = "0" & Day(Now) Me.lblDownToday.Caption = "0" Me.lblCallToday.Caption = "0" Me.lblDownMonth.Caption = "0" If CBool(rsAmbil.State And adStateOpen) = True Then rsAmbil.Close rsAmbil.Open "select * from tblPanggilan", rsCon, adOpenStatic, adLockOptimistic If rsAmbil.RecordCount > 0 Then rsAmbil.MoveFirst Do While Not rsAmbil.EOF If Left(rsAmbil!kode, 8) = strTgl & strBulan & Year(Now) Then 'menampilkan jumlah downtime dalam 1 hari

71

Me.lblDownToday.Caption = Val(Me.lblDownToday.Caption) + rsAmbil!dt 'menampilkan jumlah panggilan hari ini Me.lblCallToday.Caption = Val(Me.lblCallToday.Caption) + 1 End If If Mid(rsAmbil!kode, 3, 6) = strBulan & Year(Now) Then 'menampilkan jumlah downtime dalam 1 bulan Me.lblDownMonth.Caption = Val(Me.lblDownMonth.Caption) + rsAmbil!dt End If rsAmbil.MoveNext Loop End If End Sub

3. Listing program frmPassword (login) Private Sub cmdBatal_Click() Unload Me End Sub Private Sub cmdLanjut_Click() If Me.txtPwd = "123" Then Unload Me frmSetting.Show 1, frmMain Else MsgBox "Kata sandi salah !", vbCritical + vbOKOnly, "Peringatan" Me.txtPwd.SetFocus End If End Sub

4. Listing program frmSetting (pengaturan) Option Explicit Dim isi Private Sub cmbTema_Click() Call gantiWarna(Me.cmbTema.Text) End Sub Private Sub cmdBatal_Click() Call loadSetting End Sub Private Sub cmdBatalPort_Click() Call loadPort End Sub Private Sub cmdClose_Click() Unload Me End Sub Private Sub cmdFileSuara_Click() With Me.CommonDialog1 .CancelError = False .Filter = "MP3 Files|*.mp3" .InitDir = "c:\" .ShowOpen If .FileName "" Then Me.txtFileSuara = .FileName End If End With End Sub Private Sub cmdRefLine_Click() Set Me.DGLine.DataSource = rsLine End Sub Private Sub cmdRefresh_Click() Set Me.DGdatabase.DataSource = rsTeknisi End Sub

72

Private Sub cmdSimpan_Click() On Error GoTo err_pesan Open App.Path & "\setting.txt" For Output As #1 Print #1, "# tema" Print #1, "tema:" & Me.cmbTema Print #1, "" Print #1, "# suara" Print #1, "suara:" & Me.chkSuara.Value Print #1, "filesuara:" & Me.txtFileSuara Print #1, "suaraloop:" & Me.txtSuaraLoop Close #1 MsgBox "Pengaturan aplikasi telah tersimpan", vbInformation + vbOKOnly, "Informasi" Exit Sub err_pesan: MsgBox Err.Description End Sub Private Sub cmdSimpanPort_Click() On Error GoTo err_pesan Open App.Path & "\port.txt" For Output As #1 Print #1, "# port 1" Print #1, "1P:" & Me.txt1P Print #1, "S6:" & Me.cmbLineS6 Print #1, "S7:" & Me.cmbLineS7 Print #1, "S5:" & Me.cmbLineS5 Print #1, "S4:" & Me.cmbLineS4 Print #1, "S3:" & Me.cmbLineS3 Close #1 MsgBox "Pengaturan port paralel telah tersimpan", vbInformation + vbOKOnly, "Informasi" Exit Sub err_pesan: MsgBox Err.Description End Sub Private Sub Command1_Click() End Sub Private Sub Form_Load() Call loadSetting Call loadPort Set Me.DGdatabase.DataSource = rsTeknisi Set Me.DGLine.DataSource = rsLine End Sub Sub loadSetting() Open App.Path & "\setting.txt" For Input As #1 Do While Not EOF(1) Line Input #1, isi If Left(isi, 5) = "tema:" Then Me.cmbTema = Mid(isi, 6) ElseIf Left(isi, 6) = "suara:" Then Me.chkSuara.Value = Mid(isi, 7) ElseIf Left(isi, 10) = "filesuara:" Then Me.txtFileSuara = Mid(isi, 11) ElseIf Left(isi, 10) = "suaraloop:" Then Me.txtSuaraLoop = Mid(isi, 11) End If Loop Close #1 End Sub Sub loadPort() Open App.Path & "\port.txt" For Input As #1 Do While Not EOF(1) Line Input #1, isi Select Case Left(isi, 3) Case "1P:": Me.txt1P = Mid(isi, 4)

73

Case "S6:": Case "S7:": Case "S5:": Case "S4:": Case "S3:": End Select Loop Close #1 End Sub

Me.cmbLineS6 Me.cmbLineS7 Me.cmbLineS5 Me.cmbLineS4 Me.cmbLineS3

= = = = =

Mid(isi, Mid(isi, Mid(isi, Mid(isi, Mid(isi,

4) 4) 4) 4) 4)

Sub gantiWarna(warna As String) Select Case warna Case "hitam" frmMain.BackColor = vbBlack frmMain.frmLine.BackColor = vbBlack frmMain.frmData.BackColor = vbBlack frmMain.lblInfo.ForeColor = vbWhite frmMain.lblCallToday.ForeColor = vbWhite frmMain.lblDownMonth.ForeColor = vbWhite frmMain.lblDownToday.ForeColor = vbWhite Case "putih" frmMain.BackColor = vbWhite frmMain.frmLine.BackColor = vbWhite frmMain.frmData.BackColor = vbWhite frmMain.lblInfo.ForeColor = vbBlack frmMain.lblCallToday.ForeColor = vbBlack frmMain.lblDownMonth.ForeColor = vbBlack frmMain.lblDownToday.ForeColor = vbBlack End Select End Sub