//
// filename = Unit1.pas
//
(*
// -program-
// name : SaNNa
// host on : http://oocities.com/in2soft
// http://sourceforge.net/projects/san
// http://san.sourceforge.net
// compiler : Borland Delphi 5.0, also meybe Borland Delphi
5.x/6.0/6.x/7.0/7.x/8.0/8.x on Microsoft Windows 98/9x/me/2000
profesional/xp
// comp-note - i had tried compile it in Borland Kylix 3.0
open (linux kernel 2.2.* + GNOME)
// - as you guess i forget to check that i have no "ADO****...&others
database support" components Borland Kylix
// - well, if you wanna use it on *nix/others OS platform
// - please check "compiler/vcl/anything supported"
on http://www.borland.com
// - or find database component that supported on kylix compiler
platform from other site/search engine
// more-note : wanna migrate it's database too mysql server,
plz visit documentation at http://www.mysql.com
// - postgreSql database server, plz visit http://www.postgresql.org
//
// -about author-
// nick : enith / cynith
// name : endy k
// e-mail : crossdev@yahoo.com
// profiles : http://profiles.yahoo.com/crossdev
// http://sourceforge.net/users/in2soft
// address : Surabaya, East of Java, Indonesia
//
// -comment-
// actually i create this code for my friend, SaNNa, she maybe
a cute girl ya.. hehe.. i dunno, i dun care.. she dun want
talk 2 me anymore .. hahaha .. yup busy girl .. ekeke
// and i hope this code help you in learning OOP(versi Delphi)
AND OR any that interested on NetWorking (Inter/Intra)Net
Client side Programming (especially IRC style)
// also plz sorry for any waste code, i 'm doing my work /*something
else*/ this time
//
// -btw, plz thx f0r r34d1ng my bu11sh1t wr1t3 4b0v3 ;)-
//
// plz put your info here, if u modified/.. it (offcourse
if u let it) ... or ... uhm .. just do what's in your thinking
... well up 2 you friend.. hehe...
//
*)
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs,
ScktComp, StdCtrls, ExtCtrls, Menus, Buttons, Grids, DBGrids,
Db, ADODB;
const SETING_USER ='USER crossdev@yahoo.com mine * : SaNNa.bot.enith';
const SETING_AUTH ='PRIVMSG Q@CServe.quakenet.org :auth regnik
password';
//const SETING_NICK ='tamu';
//const SETING_HIDE ='MODE tamu +x';
type
TForm1 = class(TForm)
toket_klien: TClientSocket;
Memo1: TMemo;
Button2: TButton;
btn_send: TButton;
txt_aktif_on_room: TEdit;
txt_c212_wiro_sableng: TEdit;
Button4: TButton;
txt_priv_to: TEdit;
Button7: TButton;
Button8: TButton;
txt_nik: TEdit;
Timer1: TTimer;
m_tanya: TEdit;
m_jwb: TEdit;
txt_server: TEdit;
txt_port: TEdit;
Label5: TLabel;
Label1: TLabel;
Label2: TLabel;
adq_read: TADOQuery;
adq_edt: TADOQuery;
adocon: TADOConnection;
lbl_tambah: TLabel;
t_randomv: TTimer;
lblRandom: TLabel;
btnRecon: TSpeedButton;
BitBtn1: TBitBtn;
adq_urut: TADOQuery;
t_berita: TTimer;
SpeedButton1: TSpeedButton;
m_opsi: TEdit;
Label6: TLabel;
SpeedButton2: TSpeedButton;
t_jedaRekon: TTimer;
txt_room2: TEdit;
txt_room3: TEdit;
txt_room4: TEdit;
txt_room5: TEdit;
Button1: TButton;
Panel1: TPanel;
testing_jwb: TButton;
Edit1: TEdit;
btn_kon: TButton;
btn_dis: TButton;
Memo2: TMemo;
Button5: TButton;
t_tmpdb: TADOTable;
DataSource1: TDataSource;
DBGrid1: TDBGrid;
t_rekord: TADOTable;
Label7: TLabel;
Label3: TLabel;
Label4: TLabel;
procedure toket_klienConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure btn_konClick(Sender: TObject);
procedure toket_klienRead(Sender: TObject; Socket: TCustomWinSocket);
procedure Button2Click(Sender: TObject);
procedure btn_sendClick(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure btn_disClick(Sender: TObject);
procedure Button7Click(Sender: TObject);
procedure Button8Click(Sender: TObject);
procedure toket_klienConnecting(Sender: TObject;
Socket: TCustomWinSocket);
procedure toket_klienDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure toket_klienError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure txt_aktif_on_roomKeyPress(Sender: TObject; var Key:
Char);
procedure BitBtn1Click(Sender: TObject);
procedure t_randomvTimer(Sender: TObject);
procedure btnReconClick(Sender: TObject);
procedure t_beritaTimer(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure t_jedaRekonTimer(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure testing_jwbClick(Sender: TObject);
procedure Button5Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
protected
//
function on_msg(lSender,lTo,lMsg: string):string;
procedure db_aktif;
function db_aksi(input: string): boolean;
function db_sele_jwb(input: string): string; //-balikan-:>termasuk
function db_sele_tanya(inputTanya: string): string; //-balikan-:>jenis_tanya::standar
function tanya_replace1(inputTanya: array of string): integer;//-replace
kt2 nggak berarti
function tanya_replace2(inputBuang: string; inputTanya: array
of string): integer;
function db_sele_ada(input: string): boolean;
function tanya_jenis(inputTanya: array of string): integer;
function db_sele_berita(input: string): integer; //ret, jumlah
array berita judul+isi
procedure db_sele_berurut(input: string);
protected
path_data: string;
gJenisTanya: string;
i_randomv,i_ranBer: byte;
gtot,gtot2: integer;
gtotBerita: integer;
udah_auth: boolean;
g_sender: string;
g_arrJwb: array of string;
g_totJwb, g_iJwb: integer;
end;
var
Form1: TForm1;
//-arr, ikut maks data transfer dari server neh.
//arrA,arrB,arrC,arrD: array [0..10000] of String;
arrA,arrB,arrC,arrD: array of String;
arrBerita: array of string;
strPONG : String;
implementation
uses shellapi, uDataInfo, uUmum;
{$R *.DFM}
//-kembalikan jumlah array aja deh hihihi
function ret_sum_eksplode(var a: array of string; Border,
S: string): integer;
var
S2: string;
i: Integer;
begin
i := 0;
S2 := S + Border;
repeat
a[i] := Copy(S2, 0,Pos(Border, S2) - 1);
Delete(S2, 1,Length(a[i] + Border));
Inc(i);
until S2 = '';
//akakaka, siip
//if (i>1) then
// i :=i-1;
result :=i;
end;
function tform1.db_sele_berita(input: string): integer;
var
iRandomBerita,gTotBerita: integer;
begin
//-deaktif, wakaakakakkakak
if form1.adq_read.active then
form1.adq_read.close;
with form1 do
begin
with adq_read do
begin
sql.clear;
sql.add(input);
try
begin
execsql;
open;
iRandomBerita :=adq_read.recordcount;
SetLength(arrBerita,3); //3 aray dulu dah.. akakaka
if (iRandomBerita=1) then
begin
gTotBerita :=2;
arrBerita[0] := adq_read.fieldbyname('judul').asstring;
arrBerita[1] := adq_read.fieldbyname('isi').asstring;
result :=gTotBerita;
end
else if (iRandomBerita>1) then
begin
gTotBerita :=2;
Randomize;
adq_read.recNo :=random(iRandomBerita);
arrBerita[0] := adq_read.fieldbyname('judul').asstring;
arrBerita[1] := adq_read.fieldbyname('isi').asstring;
result :=gTotBerita;
end
else
result :=0;
end;
except on
exception do
result := 0;
end;
exit;
end;
end;
result :=gTotBerita;;
end;
procedure tform1.db_sele_berurut(input: string);
begin
//-deaktif, wakaakakakkakak
if form1.adq_urut.active then
form1.adq_urut.close;
with form1 do
begin
with adq_urut do
begin
sql.clear;
sql.add(input);
try
begin
execsql;
open;
end;
except on
exception do
end;
end;
end;
end;
//--buang kt kt ga kepake'
function tform1.tanya_replace1(inputTanya: array of string):
integer;
var
i: integer;
begin
gtot2 :=0;
for i:=0 to gtot-1 do
begin
if (false=db_sele_ada('select * from buang where kata="'+inputTanya[i]+'";'))
then
begin
arrB[gtot2] :=inputTanya[i];
inc(gtot2);
end;
end;
result :=gtot2;
end;
//--balik arrD
function tform1.tanya_jenis(inputTanya: array of string):
integer;
var
i: integer;
tmpstr: string;
begin
gtot2 :=0;
for i:=0 to gtot-1 do
begin
//if (false=db_sele_ada('select * from buang where kata="'+inputTanya[i]+'";'))
then
tmpstr :=db_sele_tanya(inputTanya[i]);
if (tmpstr='') then //-pertanyaan gak ada didata
begin
//memo1.lines.add(inputTanya[i]);
arrD[gtot2] :=inputTanya[i];
inc(gtot2);
end
else begin //-ada
gJenisTanya :=tmpstr;
end;
end;
result :=gtot2;
end;
//--buang kt kt tertentu,
function tform1.tanya_replace2(inputBuang: string; inputTanya:
array of string): integer;
var
i: integer;
begin
gtot2 :=0;
for i:=0 to gtot-1 do
begin
if (inputBuang<>inputTanya[i]) then
begin
arrC[gtot2] :=inputTanya[i];
inc(gtot2);
end;
end;
result :=gtot2;
end;
function tform1.on_msg(lSender,lTo,lMsg: string):string;
var
ret: string;
// arrA,arrB,arrC,arrD: array of String;
i,itot: integer;
// tmp: string;
// tmpi: integer;
// lMsg2: string;
queri: string;
il_ada: boolean;
begin
ret :='';
result :='';
gJenisTanya :='';
if length(lMsg)<3 then
begin
result :='';
exit; //-gak usah,.. weqs.. se mao2 gue crit..
end;
//-standar, huruf kecil
lMsg :=lowerCase(lMsg);
//-pecah-pesan ke array, hehehe
SetLength(arrA, length(lMsg)); //length di maksimalkan, gambling
crit...
itot :=ret_sum_eksplode(arrA, ' ', lMsg);
gtot :=itot;
{
//-cerita-
if ('info'=arrA[0]) then
begin
tmp :=arrA[1];
try
tmpi :=strtoint(tmp);
except on exception do
begin
result :='plz try, info [number]'; //-keluar-langsug, hemat
parsing akkaka
end;
end;
//-ambil cerita bozz
//mulai... akakaka
i_randomv :=0;
//-data
db_sele_berurut('select * from berurut where kategori="'+tmp+'"');
adq_urut.first;
t_randomv.interval :=1;
t_randomv.enabled :=true;
result :='';//-keluar
end;
}
{aha, this will help some people while chat using handphone
that lazy to find ` character}
if ('trivia'=arrA[0]) then
result :='`trivia'
else if ('strivia'=arrA[0]) then
result :='`strivia';
//--arr
SetLength(arrB, length(lMsg));
SetLength(arrC, length(lMsg));
SetLength(arrD, length(lMsg));
itot :=tanya_replace1(arrA); //--hasil=arrB
gtot :=itot;
//-buang kata2 "sanna"
itot :=tanya_replace2('sanna',arrB); //--hasil=arrC
gtot :=itot;
//-ambil tanya, gJenisTanya
itot :=tanya_jenis(arrC);//--hasil=arrD
gtot :=itot;
memo1.lines.add(inttostr(itot));
//-search-ing-1-uuuurooott
memo2.lines.add('---------search-ing....1');
il_ada :=false;
if itot>0 then
begin
//queri :='select * from berurut where kategori like "%';
queri :='select * from umum where opsi like "%';
for i:=0 to itot-1 do
begin
if ((arrD[i]<>'')AND(length(arrD[i])>2)) then //-ambil
klo bukan kosong.. ato > 3
begin
queri :=queri+arrD[i]+'%';
il_ada :=true;
memo2.lines.add('==========debug::arrD->'+arrD[i]);
end;
end;
queri :=queri+'"';
end;
if (true=il_ada) then
begin
//ret :=db_sele_jwb('select * from umum where jenis_tanya="'+gJenisTanya+'"
AND opsi like "%'+arrD[i]+'%";');
//ret :=db_sele_jwb('select * from umum where jenis_tanya="'+gJenisTanya+'"
AND opsi="'+arrD[i]+'";');
ret :=db_sele_jwb(queri);
if ret<>'' then
begin
//====debug====pertanyaan->jawaban
//memo1.lines.add('==========debug::jenisTanya->'+gJenisTanya);
memo2.lines.add('==========debug::jawaban->'+ret);
result :=ret;
exit; //wes,.. ambil aja ini, hehehe...
end;
end;
//-search-ing-2-di balik
memo2.lines.add('---------search-ing....2');
il_ada :=false;
if itot>0 then
begin
queri :='select * from umum where opsi like "%';
for i:=(itot-1) downto 0 do
begin
if ((arrD[i]<>'')AND(length(arrD[i])>2)) then //-ambil
klo bukan kosong.. ato > 3
begin
queri :=queri+arrD[i]+'%';
il_ada :=true;
memo2.lines.add('==========debug::arrD->'+arrD[i]);
end;
end;
queri :=queri+'"';
end;
if (true=il_ada) then
begin
ret :=db_sele_jwb(queri);
if ret<>'' then
begin
//====debug====pertanyaan->jawaban
//memo1.lines.add('==========debug::jenisTanya->'+gJenisTanya);
memo2.lines.add('==========debug::jawaban->'+ret);
result :=ret;
exit; //wes,.. ambil aja ini, hehehe...
end;
end;
//-searching-3---data pd tmpdb
memo2.lines.add('---------search-ing....3');
memo2.lines.add('---------uuppsss..');
memo2.lines.add('==========debug::queri->'+queri);
//--loop-tmpdb
{
if true=t_tmpdb.active then
begin
t_tmpdb.Refresh;
t_tmpdb.first;
for tmpi:=1 to t_tmpdb.recordcount do
begin
if (t_tmpdb.fieldbyname
if tmpi<t_tmpdb.recordcount then
t_tmpdb.next;
end;
end;
}
{
//-ambil jawaban
for i:=0 to itot-1 do
//for i:=0 to itot do
begin
if ((arrD[i]<>'')AND(length(arrD[i])>3)) then //-ambil
klo bukan kosong.. ato > 3
begin
//-mode-cerita-onn-
//if ('info'=arrA[0]) then
begin
//tmp :=arrA[1];
//try
// tmpi :=strtoint(tmp);
//except on exception do
// begin
// result :='plz try, info [number]'; //-keluar-langsug, hemat
parsing akkaka
// end;
//end;
tmp :=arrD[i];
//-ambil mode --cerita --berurut --bozz
//mulai... akakaka
i_randomv :=0;
//-data
memo1.lines.add('---debug--e'+arrD[i]);
db_sele_berurut('select * from berurut where kategori like
"%'+tmp+'%"');
if adq_urut.RecordCount>0 then
begin
adq_urut.first;
t_randomv.interval :=1;
t_randomv.enabled :=true;
result :='';//-keluar
exit;//pastikan aj, biar'in ekeke
end;
end;
end;
if (i=itot-1) then
result :=''; //result :='?';
end;
}
//-umum-record-:> yg panggil nama nick pertama, sampe'
die left... hehehe
//result := ret;
end;
procedure TForm1.db_aktif;
begin
// seting posisi database
// koneksi ADOTable dengan file Access
try
begin
adocon.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;'
+
'Data Source=' + path_data +
';Persist Security Info=False';
adocon.LoginPrompt := False;
adocon.Provider := 'Microsoft.Jet.OLEDB.4.0';
adocon.Connected := true;
end;
except
MessageBox(handle, 'path file data.mdb tidak ditemukan,'+#13+'tempatkan
file data.mdb bersama dg Aplikasi'+#13+#13+'...','@peringatan',MB_OK);
//f_path_db.ShowModal;
end;
end;
procedure TForm1.toket_klienConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
application.title := 'telah terhubung dg server';
socket.SendText('NICK ' + txt_nik.Text + #13+#10);
socket.SendText(SETING_USER+#13+#10);
timer1.Enabled := True;
//mulai... akakaka
i_ranBer :=0;
//-data
//db_sele_berurut('select * from berita');
//adq_urut.first;
t_berita.enabled :=true;
end;
procedure TForm1.btn_konClick(Sender: TObject);
begin
udah_auth :=false;
toket_klien.Host := txt_server.Text;
toket_klien.Port := StrToInt(txt_port.Text);
try
toket_klien.Active := True; //Connects to the host and port
except on exception
do
Showmessage('upppssss...');
end;
end;
function TForm1.db_aksi(input: string): boolean;
begin
//-deaktif, wakaakakakkakak
if form1.adq_edt.active then
form1.adq_edt.close;
with form1 do
begin
with adq_edt do
begin
sql.clear;
sql.add(input);
try
begin
execsql;
result := true;
end;
except on
exception do
result := false;
end;
exit;
end;
end;
result := false;
end;
function TForm1.db_sele_jwb(input: string): string;
var
iJwbRandom,itmp: integer;
begin
//-deaktif, wakaakakakkakak
if true=form1.adq_read.active then
form1.adq_read.close;
with form1 do
begin
with adq_read do
begin
sql.clear;
sql.add(input);
try
begin
execsql;
open;
iJwbRandom :=adq_read.recordcount;
if (iJwbRandom=1) then
begin
result := adq_read.fieldbyname('jawab').asstring;
end
else if (iJwbRandom>1) then
begin
Randomize;
itmp :=random(iJwbRandom+1);
if itmp<2 then
itmp :=1;
//showmessage(inttostr(itmp));
adq_read.recNo :=itmp;
result := adq_read.fieldbyname('jawab').asstring;
end
else
result :='';
end;
except on
exception do
result := '';
end;
exit;
end;
end;
result := '';
end;
function TForm1.db_sele_ada(input: string): boolean;
begin
//-deaktif, wakaakakakkakak
if form1.adq_read.active then
form1.adq_read.close;
with form1 do
begin
with adq_read do
begin
sql.clear;
sql.add(input);
try
begin
execsql;
open;
if (adq_read.recordcount>0) then
begin
adq_read.first;
result := true;
end
else
result :=false;
end;
except on
exception do
result := false;
end;
exit;
end;
end;
result := false;
end;
function TForm1.db_sele_tanya(inputTanya: string): string;
var
tmpstr: string;
begin
//-deaktif, wakaakakakkakak
if form1.adq_read.active then
form1.adq_read.close;
tmpstr :='select * from `jenis_tanya` where tanya="'+inputTanya+'";';
with form1 do
begin
with adq_read do
begin
sql.clear;
sql.add(tmpstr);
try
begin
execsql;
open;
if adq_read.recordcount>0 then
begin
result := adq_read.fieldbyname('jenis').asstring;
exit; //-gak pake' iki gak pa pa.. u/ meyakinkan duank.. iki
kan delphi bukan C hehehe
end
else
result :='';
end;
except on
exception do
result := '';
end;
end;
end;
result := '';
end;
procedure TForm1.toket_klienRead(Sender: TObject;
Socket: TCustomWinSocket);
var
sData : String;
tmp1 :String;
tmpSender,tmpTo,tmpMsg,tmpJwb: string;
itmp,itmp2: integer;
begin
sData := Socket.ReceiveText;
if (length(sData)>0) then
begin
//-jawab PING->PONG--------siiiiippppp
tmp1 := copy(sData,0,length('PING :'));
if tmp1='PING :' then //PING :
begin
//--quakenet wanna this one -> /QUOTE PONG xxxxx
tmp1 :=copy(sData,7,length(sData)-7);
memo2.lines.add('-------debug::PING->PONG :'+tmp1);
strPONG :='PONG :'+tmp1;
Socket.Sendtext(strPONG +#13+#10);
if (false=udah_auth) then
begin
Socket.Sendtext(SETING_AUTH+#13+#10);
Socket.Sendtext('MODE '+txt_nik.text+' +x'+#13+#10);
udah_auth :=true;
//---sleep,.....belon
//-join--awal
toket_klien.Socket.SendText('JOIN ' + txt_aktif_on_room.Text
+ #13+#10);
toket_klien.Socket.SendText('MODE ' + txt_aktif_on_room.Text
+ #13+#10);
toket_klien.Socket.SendText('JOIN ' + txt_room2.Text + #13+#10);
toket_klien.Socket.SendText('MODE ' + txt_room2.Text + #13+#10);
toket_klien.Socket.SendText('JOIN ' + txt_room3.Text + #13+#10);
toket_klien.Socket.SendText('MODE ' + txt_room3.Text + #13+#10);
toket_klien.Socket.SendText('JOIN ' + txt_room4.Text + #13+#10);
toket_klien.Socket.SendText('MODE ' + txt_room4.Text + #13+#10);
toket_klien.Socket.SendText('JOIN ' + txt_room5.Text + #13+#10);
toket_klien.Socket.SendText('MODE ' + txt_room5.Text + #13+#10);
//--defender-peringatan-1
i_randomv :=0;
//-data
db_sele_berurut('select * from berurut where kategori="N_AWAL"');
adq_urut.first;
t_randomv.interval :=1;
t_randomv.enabled :=true;
end
else begin
//-rejoin
toket_klien.Socket.SendText('JOIN ' + txt_aktif_on_room.Text
+ #13+#10);
toket_klien.Socket.SendText('MODE ' + txt_aktif_on_room.Text
+ #13+#10);
toket_klien.Socket.SendText('JOIN ' + txt_room2.Text + #13+#10);
toket_klien.Socket.SendText('MODE ' + txt_room2.Text + #13+#10);
toket_klien.Socket.SendText('JOIN ' + txt_room3.Text + #13+#10);
toket_klien.Socket.SendText('MODE ' + txt_room3.Text + #13+#10);
toket_klien.Socket.SendText('JOIN ' + txt_room4.Text + #13+#10);
toket_klien.Socket.SendText('MODE ' + txt_room4.Text + #13+#10);
toket_klien.Socket.SendText('JOIN ' + txt_room5.Text + #13+#10);
toket_klien.Socket.SendText('MODE ' + txt_room5.Text + #13+#10);
end;
end
else if (tmp1='ERROR ') then //ERROR :
begin
btnreconClick(sender);
end
else begin
//---ekkekekke
itmp :=ansipos('PRIVMSG ',sData);
if (itmp>0) then
begin
memo1.lines.add('---debug:PRIVMSG::--itmp='+inttostr(itmp));
//tmpMsg :=copy(sData,itmp,length(sData)-itmp);
//--sender, neh
tmp1 := copy(sData,0,1);
if (tmp1=':') then
begin
itmp2 :=ansipos('!',sData);
if (itmp2>0) then
tmpSender :=copy(sData,2,itmp2-2)
else begin
itmp2 :=ansipos(' ',sData);
tmpSender :=copy(sData,2,itmp2-2);
end;
end;
//--to, neh
itmp2 :=ansipos(' :',sData);
tmpTo :=copy(sData,itmp+8,(itmp2-(2+itmp+6)));//+8=privmsg
if (itmp2>0) then
itmp2 :=itmp2+2;
tmpMsg :=copy(sData,itmp2,length(sData)-itmp2-1);//-t.o.p
... hehehe
memo2.lines.add('---debug:PRIVMSG::--tmpSender='+tmpSender);
memo2.lines.add('---debug:PRIVMSG::--tmpTo='+tmpTo);
memo2.lines.add('---debug:PRIVMSG::--tmpMsg='+tmpMsg);
//-update
//-validasi sebelum di parsing
//--quakenet ngirim tmpTo="", padahal belon e|nix
register
if tmpTo='' then
begin
memo2.lines.add('============tmpTo kosong,,, gak jadi parsing');
exit;
end;
//-rekording-di canel doank.. biar agak ringan
if ('#'=copy(tmpTo,1,1)) then
begin
//--update-dt-temporer
if true=adq_edt.active then
adq_edt.Close;
adq_edt.sql.clear;
adq_edt.sql.add('insert into tmpdb '+
'(canel,nik,opsi,jawab)'+
'values'+
'("'+tmpTo+'","'+tmpSender+'","'+tmpMsg+'","")');
try
adq_edt.execSql;
except on exception do
begin
//-err-eksekusi::tmpdb
memo2.Lines.Add('--debug-err`-update');
end;
end;
t_rekord.close;
t_rekord.open;
t_rekord.Last;
end;
if g_sender='' then //--jawab klo sender dah kosong, single
...
begin
//-dimana sih si pe-ngirim
//g_sender :=tmpSender;
tmpJwb :=on_msg(tmpSender,tmpTo,TmpMsg);
//eksplode ulang jawaban, pecah ke arr_gJwb[]
if length(tmpJwb)<1 then
exit;
SetLength(g_arrJwb, length(tmpJwb)); //length di maksimalkan,
gambling crit...
g_totJwb :=ret_sum_eksplode(g_arrJwb, '|=truz=|', tmpJwb);
//g_totJwb :=itot;
if (tmpJwb<>'') then
begin
if ('#'=copy(tmpTo,1,1)) then
begin
g_sender :=tmpTo;
//--update-dt-temporer
if true=adq_edt.active then
adq_edt.Close;
adq_edt.sql.clear;
adq_edt.sql.add('insert into tmpdb '+
'(canel,nik,opsi,jawab)'+
'values'+
'("'+tmpTo+'","'+tmpSender+'","'+tmpMsg+'","")');
try
adq_edt.execSql;
except on exception do
begin
//-err-eksekusi::tmpdb
end;
end;
end
else
g_sender :=tmpSender;
g_iJwb :=0;
t_randomv.interval :=1;
t_randomv.enabled :=true;
end;
end;
end;
end; //--end-selain PING
end;
memo1.Lines.add(sData);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
toket_klien.Socket.SendText('JOIN ' + txt_aktif_on_room.Text
+ #13+#10);
toket_klien.Socket.SendText('MODE ' + txt_aktif_on_room.Text
+ #13+#10);
end;
procedure TForm1.btn_sendClick(Sender: TObject);
begin
toket_klien.Socket.SendText('PRIVMSG ' + txt_aktif_on_room.Text
+ ' :' + txt_c212_wiro_sableng.Text + #13+#10);
Memo1.Lines.Add(txt_nik.Text + ': ' + txt_c212_wiro_sableng.Text);
//txt_c212_wiro_sableng.Text := '';
txt_c212_wiro_sableng.selectall;
txt_c212_wiro_sableng.setfocus;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
toket_klien.Socket.SendText('PRIVMSG ' + txt_priv_to.Text
+ ' :' + txt_c212_wiro_sableng.Text + #13+#10);
memo1.lines.add('--privat---' + txt_priv_to.Text + ' :' +
txt_c212_wiro_sableng.Text);
txt_c212_wiro_sableng.setfocus;
end;
procedure TForm1.btn_disClick(Sender: TObject);
begin
toket_klien.Socket.SendText('QUIT :lagi mabok.. hehe ' + #13+#10);
Memo1.Lines.Add('Disconnected...');
end;
procedure TForm1.Button7Click(Sender: TObject);
begin
toket_klien.Socket.SendText('PART ' + txt_aktif_on_room.Text
+ #13+#10);
end;
procedure TForm1.Button8Click(Sender: TObject);
begin
toket_klien.Socket.SendText('NICK :' + txt_nik.Text + #13+#10);
end;
procedure TForm1.toket_klienConnecting(Sender: TObject;
Socket: TCustomWinSocket);
begin
application.title := 'konektiinnnggg.....';
end;
procedure TForm1.toket_klienDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
application.title := 'diskonek crit';
Timer1.Enabled := False;
t_randomv.enabled :=false;
t_berita.enabled :=false;
end;
procedure TForm1.toket_klienError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
application.title := 'maaf error, kode='+inttostr(errorcode);
memo1.lines.add(application.title);
timer1.enabled := False;
t_randomv.enabled :=false;
t_berita.enabled :=false;
//btn_disClick(sender);//--gawat, kirim balek lg ksini die..akakaka
//if errorcode=10060 then
// errorcode :=0;
//btnReconClick(sender);//re
t_jedaRekon.enabled :=true;
errorcode :=0;//no error report neh hehe
end;
//----180000 ->kelamaan .. akakaka
//----100.000 -> masi telat
//--testing -> 50000
procedure TForm1.Timer1Timer(Sender: TObject);
begin
toket_klien.Socket.SendText('PONG :'+txt_server.text+ #13+#10);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
g_sender :='';
g_totJwb :=0;
path_data := extractfilepath(application.exename);
path_data := path_data + 'dt_neh.mdb';
db_aktif;
t_rekord.open;
t_rekord.last;
if false=t_tmpdb.Active then
try
t_tmpdb.open;
except on exception do
begin
//--errrur
end;
end;
end;
procedure TForm1.txt_aktif_on_roomKeyPress(Sender: TObject;
var Key: Char);
begin
if key = #13 then
Button2.Click;
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
if (db_aksi('insert into umum (opsi,jawab) values ("'+m_tanya.text+'","'+m_jwb.text+'");')
)then
lbl_tambah.caption :='siip'
else
lbl_tambah.caption :='gagal neh';
end;
//--- jeda siiip=60000
//- tes jeda cepet neh
procedure TForm1.t_randomvTimer(Sender: TObject);
//var
// tmpI: integer;
begin
//i_randomv :=0; //gak dipake' dulu, nyoba' bagian yg laen
//--info
//10 x 1 menit = ngoceh
inc(i_randomv);
//if (i_randomv>10) then
//if (i_randomv>5) then
if g_sender<>'' then
begin
i_randomv :=0;
if true=toket_klien.Active then
begin
t_randomv.Interval :=2000;
if (g_iJwb<g_totJwb) then
begin
toket_klien.Socket.SendText('PRIVMSG ' + g_sender + ' :' +
g_arrJwb[g_iJwb] + #13+#10);
inc(g_iJwb);
end
else begin
t_randomv.Interval :=1;//20000;
t_randomv.enabled :=false;
g_sender :=''; //-reset-g_sender---acuan---
g_iJwb :=0;
//-diseleksi pas dipilih
//db_sele_berurut('select * from berurut');
//adq_urut.first;
end;
end;
end;
lblRandom.caption :=inttostr(i_randomv);
end;
procedure TForm1.btnReconClick(Sender: TObject);
begin
t_jedaRekon.enabled :=false;
Memo1.Lines.Add('error...');
Memo1.Lines.Add('re-koneksi...');
Memo1.Lines.Add('Diskoneksi..');
btn_disClick(sender);
btn_konClick(sender);
end;
procedure TForm1.t_beritaTimer(Sender: TObject);
var
tmpI: integer;
begin
////---berita random
//10 x 1 menit = ngoceh
inc(i_ranBer);
//if (i_ranBer>10) then
if (i_ranBer>3) then
begin
i_ranBer :=0;
if true=toket_klien.Active then
begin
tmpI :=db_sele_berita('select * from berita');
if tmpI>0 then
begin
toket_klien.Socket.SendText('PRIVMSG ' + txt_aktif_on_room.text
+ ' :' + arrBerita[0] + #13+#10);
end;
end;
end;
lblRandom.caption :=inttostr(i_ranBer);
end;
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
if false=fdt.ADOTable1.Active then
fdt.ADOTable1.Active :=true;
fdt.show;
end;
procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
if false=fumum.ADOTable1.Active then
fumum.ADOTable1.Active :=true;
fumum.show;
end;
procedure TForm1.t_jedaRekonTimer(Sender: TObject);
begin
btnReconClick(sender);//re
end;
procedure TForm1.Button1Click(Sender: TObject);
var
tmp1,tmp2,tmp3: string;
begin
tmp1 :='a';
tmp2 :='b';
tmp3 :='c';
db_sele_berurut('select * from berurut where kategori like
"%'+tmp1+'%'+tmp2+'%'+tmp3+'%"');
if adq_urut.RecordCount>0 then
begin
showmessage('siip');
end;
end;
procedure TForm1.testing_jwbClick(Sender: TObject);
var
tmpJwb: string;
i: integer;
begin
tmpJwb :=on_msg('seendderr','too',edit1.text);
if length(tmpJwb)<1 then
exit;
//eksplode ulang jawaban, pecah ke arr_gJwb[]
SetLength(g_arrJwb, length(tmpJwb)); //length di maksimalkan,
gambling crit...
g_totJwb :=ret_sum_eksplode(g_arrJwb, '|=truz=|', tmpJwb);
for i:=0 to g_totJwb-1 do
begin
showmessage(g_arrJwb[i]);
end;
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
//--update-dt-temporer
if true=adq_edt.active then
adq_edt.Close;
adq_edt.sql.clear;
adq_edt.sql.add('insert into tmpdb '+
'(canel,nik,opsi,jawab)'+
'values'+
'("ss","ss","ss","")');
try
adq_edt.execSql;
except on exception do
begin
//-err-eksekusi::tmpdb
memo2.Lines.Add('--debug-err`-update');
end;
end;
end;
end.
|
