unit uniData;
// SQLite client version: 3.42.0 on Linux, 3.45.1
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils, Controls, Dialogs, StdCtrls, Grids, ExtCtrls, Math,
uniStorage;
type
TSetting = record
DataFileName: string[30];
ThresholdTransaksi: (ttJual, ttBeli);
NamaMataUangUtama: string[10];
DeskMataUangUtama: string[20];
NamaMataUangThres: string[10];
DeskMataUangThres: string[20];
NamaMataUangLen: Byte;
DeskMataUangLen: Byte;
NilaiMaksimum: integer;
NilaiDesimal: Byte;
end;
var
Setting: TSetting;
Type
TTableName = (tblMataUang,tblRate, tblNasabah, tblNasabahJenis,
tblWargaNegara, tblPekerjaan, tblTransaksi);
function isStringTooLong(var S: string; Len: Integer): Boolean;
function isEditTooLong(Edit: TEdit; Len: Integer): Boolean;
function isEditTooLong(lbeEdit: TLabeledEdit; Len: Integer): Boolean;
function isValueBad(Value: string): Boolean;
procedure SanitizeValue(var Value: Double);
procedure SanitizeValue(var Value: string);
procedure SanitizeValue(lbeEdit: TLabeledEdit);
function ErrorMessage: string;
procedure CreateDatabase;
function ConfirmDelete(const Info: string): Boolean;
procedure TableBrowse(tbl: TTableName; Grid: TStringGrid; Page: Integer);
procedure TableDelete(tbl: TTableName; const ID: string);
function TableRecordCount(tbl: TTableName) : Integer;
// Transaksi
procedure AddTransaksi(const Nasabah, MataUang, Rate, Waktu, Beli, Jual,
Total, Threshold: string);
procedure EditTransaksi(const ID, Nasabah, MataUang, Rate, Beli, Jual,
Total, Threshold: string);
function GetTransaksiNasabah(const ID: string): string;
function GetTransaksiMataUang(const ID: string): string;
function GetTransaksiWaktu(const ID: string; Format: Boolean): string;
function isTransaksiBad(const Nasabah, MataUang, Rate, Waktu, Beli, Jual:
string): Boolean;
// Mata Uang
procedure AddMataUang(const Nama, Deskripsi: string);
procedure EditMataUang(const ID, Nama, Deskripsi: string);
function GetMataUangNama(const ID: string): string;
function isMataUangBad(const ID, Nama, Deskripsi: string): Boolean;
// Rate
procedure AddRate(const Waktu, MataUang, Jual, Beli: string);
procedure EditRate(const ID, MataUang, Jual, Beli: string);
function GetRateMataUang(const ID: string): string;
function GetRateWaktu(Const ID: string; Format: Boolean): string;
function isRateBad(const ID, Waktu, MataUang, Jual, Beli: string): Boolean;
function GetRate(const MataUang, Waktu: string; strResult: TStringList):
Boolean;
function GetRateBeli(const MataUang, Waktu: string): string;
function GetRateJual(const MataUang, Waktu: string): string;
function GetRateMiddle(const Waktu: string): string;
// Nasabah
procedure AddNasabah(const Nama, Jenis, Identitas, WargaNegara, Pekerjaan:
string);
procedure EditNasabah(const ID, Nama, Jenis, Identitas, WargaNegara, Pekerjaan:
string);
function GetNasabahNama(const ID: string): string;
function GetNasabahJenis(const ID: string): string;
function GetNasabahWargaNegara(Const ID: string): string;
function GetNasabahPekerjaan(Const ID: string): string;
function isNasabahBad(const ID, Nama, Jenis, Identitas, WargaNegara, Pekerjaan:
string): Boolean;
// Nasabah Jenis
procedure AddNasabahJenis(const Deskripsi: string);
procedure EditNasabahJenis(const ID, Deskripsi: string);
function GetJenisDeskripsi(const ID: string): string;
function isNasabahJenisBad(const ID, Deskripsi: string): Boolean;
// Warga Negara
procedure AddWargaNegara(const Deskripsi: string);
procedure EditWargaNegara(const ID, Deskripsi: string);
function GetWargaNegaraDeskripsi(const ID: string): string;
function isWargaNegaraBad(const ID, Deskripsi: string): Boolean;
// Pekerjaan
procedure AddPekerjaan(const Deskripsi: string);
procedure EditPekerjaan(const ID, Deskripsi: string);
function GetPekerjaanDeskripsi(const ID: string): string;
function isPekerjaanBad(const ID, Deskripsi: string): Boolean;
// Setting
procedure AddSetting(const Threshold, Maksimum, Desimal: string);
procedure ReadSettings;
const
DataFileName = 'vnsData.sqlite';
DateTimeFormat = 'dd-mm-yy hh:nn:ss';
MataUangNamaLength = 10;
MataUangDeskripsiLength = 20;
NasabahNamaLength = 30;
NasabahIdentitasLength = 20;
NasabahJenisDeskripsiLength = 20;
WargaNegaraDeskripsiLength = 35;
PekerjaanDeskripsiLength = 30;
implementation
uses
fruWaktu;
function TableName(tbl: TTableName): string; forward;
procedure PrepareData; forward;
procedure DoQuery(const S: string); forward;
function isTableHasID(tbl: TTableName; const ID: string): Boolean; forward;
procedure RateCallBack(Sender: TObject; AData: Pointer); forward;
const
// Transaksi
sqlCreateTransaksi =
'CREATE TABLE tblTransaksi ( ' +
'ID INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, ' +
'Nasabah INTEGER NOT NULL, ' + // NasabahID
'MataUang INTEGER NOT NULL, ' + // MataUangID
'Rate INTEGER NOT NULL, ' + // RateID
'Waktu REAL NOT NULL, ' +
'Beli REAL NOT NULL, ' +
'Jual REAL NOT NULL, ' +
'Total REAL NOT NULL, ' +
'Threshold REAL NOT NULL ) STRICT;';
sqlAddTransaksi =
'INSERT INTO tblTransaksi (Nasabah, MataUang, Rate, Waktu, Beli, Jual, ' +
'Total, Threshold) VALUES (''';
sqlDeleteTransaksi =
'DELETE FROM tblTransaksi WHERE ID=''';
sqlEditTransaksi =
'UPDATE tblTransaksi SET ';
sqlBrowseTransaksi =
'Transaksi.ID, Waktu, Nsb.Nama, Uang.Nama, Jual, Beli, Total, Threshold ' +
'FROM tblTransaksi AS Transaksi ' +
'LEFT JOIN tblMataUang AS Uang ON Transaksi.MataUang=Uang.ID ' +
'LEFT JOIN tblNasabah AS Nsb ON Nasabah=Nsb.ID';
// Mata Uang
sqlCreateMataUang =
'CREATE TABLE tblMataUang ( ' +
'ID INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, ' +
'Nama TEXT NOT NULL UNIQUE, ' +
'Deskripsi TEXT NOT NULL UNIQUE, ' +
'CHECK (length(Nama) <= 10 AND length(Deskripsi) <= 20) ) STRICT;';
sqlAddMataUang =
'INSERT INTO tblMataUang (Nama, Deskripsi) VALUES (''';
sqlDeleteMataUang =
'DELETE FROM tblMataUang WHERE ID=''';
sqlEditMataUang =
'UPDATE tblMataUang SET ';
sqlTestMataUangNama =
'SELECT * FROM tblMataUang WHERE Nama=''';
sqlTestMataUangDeskripsi =
'SELECT * FROM tblMataUang WHERE Deskripsi=''';
// Rate
sqlCreateRate =
'CREATE TABLE tblRate ( ' +
'ID INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, ' +
'Waktu REAL NOT NULL, ' +
'MataUang INTEGER NOT NULL, ' +
'Beli REAL NOT NULL, ' +
'Jual REAL NOT NULL, ' +
'Tengah REAL NOT NULL ) STRICT;';
sqlAddRate =
'INSERT INTO tblRate (Waktu, MataUang, Beli, Jual, Tengah) VALUES (''';
sqlDeleteRate =
'DELETE FROM tblRate WHERE ID=''';
sqlEditRate =
'UPDATE tblRate SET ';
sqlBrowseRate =
'Rate.ID, Waktu, Uang.Nama, Jual, Beli, Tengah FROM tblRate ' +
'AS Rate LEFT JOIN tblMataUang AS Uang ON Rate.MataUang=Uang.ID';
// Nasabah
sqlCreateNasabah =
'CREATE TABLE tblNasabah ( ' +
'ID INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, ' +
'Nama TEXT NOT NULL, ' +
'Jenis INTEGER NOT NULL, ' +
'Identitas TEXT NOT NULL UNIQUE, ' +
'WargaNegara INTEGER NOT NULL, ' +
'Pekerjaan INTEGER NOT NULL, ' +
'CHECK (length(Nama) <= 30 AND length(Identitas) <= 20) ) STRICT;';
sqlAddNasabah =
'INSERT INTO tblNasabah ' +
'(Nama, Jenis, Identitas, WargaNegara, Pekerjaan) VALUES (''';
sqlDeleteNasabah =
'DELETE FROM tblNasabah WHERE ID=''';
sqlEditNasabah =
'UPDATE tblNasabah SET ';
sqlTestNasabahIdentitas =
'SELECT * FROM tblNasabah WHERE Identitas=''';
sqlBrowseNasabah =
'Nsb.ID, Nama, Jns.Deskripsi, Identitas, Wga.Deskripsi, ' +
'Pkj.Deskripsi FROM tblNasabah AS Nsb ' +
'LEFT JOIN tblNasabahJenis AS Jns ON Nsb.Jenis=Jns.ID ' +
'LEFT JOIN tblWargaNegara AS Wga ON Nsb.WargaNegara=Wga.ID ' +
'LEFT JOIN tblPekerjaan As Pkj On Nsb.Pekerjaan=Pkj.ID';
// NasabahJenis
sqlCreateNasabahJenis =
'CREATE TABLE tblNasabahJenis ( ' +
'ID INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, ' +
'Deskripsi TEXT NOT NULL UNIQUE, ' +
'CHECK(length(Deskripsi) <= 20) ) STRICT;';
sqlAddNasabahJenis =
'INSERT INTO tblNasabahJenis (Deskripsi) VALUES (''';
sqlDeleteNasabahJenis =
'DELETE FROM tblNasabahJenis WHERE ID=''';
sqlEditNasabahJenis =
'UPDATE tblNasabahJenis SET Deskripsi=''';
sqlTestNasabahJenisDeskripsi =
'SELECT * FROM tblNasabahJenis WHERE Deskripsi=''';
// WargaNegara
sqlCreateWargaNegara =
'CREATE TABLE tblWargaNegara ( ' +
'ID INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, ' +
'Deskripsi TEXT NOT NULL UNIQUE, ' +
'CHECK(length(Deskripsi) <= 35) ) STRICT;';
sqlAddWargaNegara =
'INSERT INTO tblWargaNegara (Deskripsi) VALUES (''';
sqlDeleteWargaNegara =
'DELETE FROM tblWargaNegara WHERE ID=''';
sqlEditWargaNegara =
'UPDATE tblWargaNegara SET Deskripsi=''';
sqlTestWargaNegaraDeskripsi =
'SELECT * FROM tblWargaNegara WHERE Deskripsi=''';
// Pekerjaan
sqlCreatePekerjaan =
'CREATE TABLE tblPekerjaan ( ' +
'ID INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, ' +
'Deskripsi TEXT NOT NULL UNIQUE, ' +
'CHECK(length(Deskripsi) <= 30) ) STRICT;';
sqlAddPekerjaan =
'INSERT INTO tblPekerjaan (Deskripsi) VALUES (''';
sqlDeletePekerjaan =
'DELETE FROM tblPekerjaan WHERE ID=''';
sqlEditPekerjaan =
'UPDATE tblPekerjaan SET Deskripsi=''';
sqlTestPekerjaanDeskripsi =
'SELECT * FROM tblPekerjaan WHERE Deskripsi=''';
// General
sqlWhereID =
' WHERE ID=''';
// Setting
sqlCreateSetting =
'CREATE TABLE tblSetting ( ' +
'ThresholdTransaksi INTEGER NOT NULL, ' +
'NilaiMaksimum INTEGER NOT NULL, ' +
'NilaiDesimal INTEGER NOT NULL, ' +
'CHECK (ThresholdTransaksi >= 0 AND ThresholdTransaksi <= 1 AND ' +
'NilaiMaksimum >= 1000000 AND NilaiMaksimum <= 1000000000 AND ' +
'NilaiDesimal >= 0 AND NilaiDesimal <= 3) ) STRICT;';
sqlAddSetting =
'INSERT INTO tblSetting ' +
'(ThresholdTransaksi, NilaiMaksimum, NilaiDesimal) VALUES (''';
const
// Transaksi
ErrTransaksiRateNotFound =
'Belum ada rate untuk mata uang tersebut,' + LineEnding +
'silahkan diisikan ratenya terlebih dahulu.';
ErrTransaksiEmpty =
'Semua item tidak boleh kosong.';
ErrTransaksiNilai =
'Nilai harus di atas 0 dan maksimum ';
// Mata Uang
ErrMataUangIDNotFound =
'Internal error, MataUangID.';
ErrMataUangEmpty =
'Nama dan Keterangan tidak boleh kosong.';
ErrMataUangDuplicate =
'Mata uang tersebut sudah ada,' + LineEnding +
'silahkan isikan yang lain.';
ErrMataUangLengthNama =
'Maksimum 10 character untuk nama mata uang.';
ErrMataUangLengthDesc =
'Maksimum 20 character untuk keterangan mata uang.';
// Rate
ErrRateEmpty =
'Semua item tidak boleh kosong.';
ErrRateBeliValue =
'Rate beli harus di atas 0 dan maksimum ';
ErrRateJualValue =
'Rate jual harus di atas 0 dan maksimum ';
// Nasabah
ErrNasabahIDNotFound =
'Internal error, NasabahID.';
ErrNasabahEmpty =
'Semua item tidak boleh kosong.';
ErrNasabahDuplicateDesc =
'Nasabah dengan identitas tersebut sudah ada.';
ErrNasabahLengthNama =
'Maksimum 30 character untuk nama nasabah.';
ErrNasabahLengthIdentitas =
'Maksimum 20 character untuk identitas nasabah.';
// NasabahJenis
ErrNasabahJenisIDNotFound =
'Internal error, NasabahJenisID.';
ErrNasabahJenisEmpty =
'Jenis nasabah tidak boleh kosong.';
ErrNasabahJenisDuplicateDesc =
'Jenis nasabah tersebut sudah ada,' + LineEnding +
'silahkan isikan jenis nasabah yang lain.';
ErrNasabahJenisLengthDesc =
'Maksimum 20 character untuk jenis nasabah.';
// WargaNegara
ErrWargaNegaraIDNotFound =
'Internal error, WargaNegaraID.';
ErrWargaNegaraEmpty =
'Warga negara tidak boleh kosong.';
ErrWargaNegaraDuplicateDesc =
'Warga negara tersebut sudah ada,' + LineEnding +
'silahkan isikan nama warga negara yang lain.';
ErrWargaNegaraLengthDesc =
'Maksimum 35 character untuk nama warga negara.';
// Pekerjaan
ErrPekerjaanIDNotFound =
'Internal error, PekerjaanID.';
ErrPekerjaanEmpty =
'Pekerjaan tidak boleh kosong.';
ErrPekerjaanDuplicateDesc =
'Pekerjaan tersebut sudah ada,' + LineEnding +
'silahkan isikan nama pekerjaan yang lain.';
ErrPekerjaanLengthDesc =
'Maksimum 30 character untuk nama pekerjaan.';
var
Data: TSQLite = nil;
ErrorMsg: string = '';
...
Recent
