kodlarının açıklamaları mevcuttur.
Bu işlemler Twebbrowser ve HTML parser kullanıldı.
Not:Kodlar çok düzenli olamayabilir. Bir önceki programımın üzerinden değişiklik yapıp oluşturduğum için tanımlanmış ve kullanılmayan değişkenler kodlar bulunabilir. Ayrıca kodları daha da optimize edecek arkadaşlar olursa sevirim.
Form üzerine bir adet twebbrowser nesnesi ekleyin.
Gerekli unitler.
Kod: Tümünü seç
uses
OleCtrls, mshtml;
Kod: Tümünü seç
var
Form1: TForm1;
ovElements: OleVariant;
iall : IHTMLElement;
Bu işlem için formun bulunduğu web sayfası açılır Firefox da açılır.

http://tckimlik.nvi.gov.tr/Web/QueryIdentityNumber.aspx
Program tarafından doldurulacak form neslerinin tamamı mouse ile seçilir.
Sağ tuş "Seçimin Kaynak Kodunu Göster" seçilerek. Sadece Form'a ait kodların görünmesi sağlanır.
Bu kodlar içinde name=" ile başlayan isimler hemen üstündeki alanın adını verir.
Aşğıda Adı: alanı için kod parçasını görebilirsiniz. Bu kod da formu doldurmak için
name="ctlFirstName" deki "ctlFirstName" ismi kullanılmaktadır.
Kod: Tümünü seç
<TD>Adı:</TD>
<TD><input name="ctlFirstName" type="text" maxlength="50" id="ctlFirstName" class="TXT" /></TD>
Programımızda bu alanlara bilgi göndermek istediğimizi FillForm procedure'üne "TIKLA" bilgisini
giriyoruz.
Doldurulacak alanların isimlerini öğrendikten sonra kodlamaya geçebiliriz.
Kullanımı : FillForm(WebBrowser1, 'ctlFirstName', adie.Text);
webbrowser1 : Form a eklenen twebbrowser nesnesi.
'ctlFirstName': Doldurulacak alanın adı.
adie.text : Doldurulacak alana girilecek bilgi.
Web sayfasındaki formları doldurmak için kullanılan function.
Kod: Tümünü seç
function FillForm(WebBrowser: TWebBrowser; FieldName: string; Value: string): Boolean;
var
i, j: Integer;
FormItem: Variant;
begin
Result := False;
if WebBrowser.OleObject.Document.all.tags('FORM').Length = 0 then
begin
Exit;
end;
for I := 0 to WebBrowser.OleObject.Document.forms.Length - 1 do
begin
FormItem := WebBrowser.OleObject.Document.forms.Item(I);
for j := 0 to FormItem.Length - 1 do
begin
try
//Alanın adı istediğimiz alana eşitse o kutuya bilgiyi yaz
if FormItem.Item(j).Name = FieldName then
begin
//Alanın değeri TIKLA ise form biglisi gönder olayı gerçekleştir.
if value='TIKLA' then
//Gönder butonu bulundu bilgi gönderiliyor.
FormItem.Item(j).click
else FormItem.Item(j).Value := Value;
Result := True;
end;
except
Exit;
end;
end;
end;
end;
Kod: Tümünü seç
procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
//Birey no , Ciltno ya göre sorgulama yapılıyorsa aşağıdaki bilgileri form nesnelerine gönder.
if buton='birey' then
begin
FillForm(WebBrowser1, 'ctlFirstName', adie.Text);
FillForm(WebBrowser1, 'ctlLastName', soyadie.Text);
FillForm(WebBrowser1, 'ctlCilt', ciltno.Text);
FillForm(WebBrowser1, 'ctlAileSiraNo', aileno.text);
FillForm(WebBrowser1, 'ctlSiraNo', sirano.Text);
FillForm(WebBrowser1, 'ctlCity',ilisecti);
FillForm(WebBrowser1, 'ctlDistrict',ilcesecti);
FillForm(WebBrowser1, 'ctlQueryFromData','TIKLA'); //Form daki bilgileri gönderen butonun adı.
//Form sayfasının HTML kodu memo1 nesnesine aktarılıyor.
memo1.Clear;
if Assigned(WebBrowser1.Document) then
begin
iall := (WebBrowser1.Document AS IHTMLDocument2).body;
while iall.parentElement <> nil do
begin
iall := iall.parentElement;
end;
x:= iall.outerHTML;
end;
memo1.text:=x;
//Sayafa içinde BOLD kelimesi bulunuyorsa ve bu kelime 20 karakter den daha uzun bir mesafedeyse
//birey bilgileri gelmiş demektir.Bunları listelemek için işleme başla.
if pos('BOLD',memo1.Text)>20 then siranokimlikdogrula;
end;
//Ana adı, Baba adına göre sorgulama yapılıyorsa aşağıdaki bilgileri form nesnelerine gönder.
if buton='babaadi' then
begin
FillForm(WebBrowser1, 'ctlCity',ilisecti);
FillForm(WebBrowser1, 'ctlDistrict',ilcesecti);
FillForm(WebBrowser1, 'ctlFirstName', adie.text);
FillForm(WebBrowser1, 'ctlLastName', soyadie.Text);
FillForm(WebBrowser1, 'ctlFatherName', babaadie.Text);
FillForm(WebBrowser1, 'ctlMotherName', anaadie.text);
FillForm(WebBrowser1, 'ctlBirthDate', edit13.Text);
if cinsiyetkutu.Text='Erkek' then cinsiyetsec:='E';
if cinsiyetkutu.Text='Kadın' then cinsiyetsec:='K';
FillForm(WebBrowser1, 'ctlSex', cinsiyetsec);
FillForm(WebBrowser1, 'ctlQueryFromPersonalInfo','TIKLA'); //Form daki bilgileri gönderen butonun adı.
memo1.Clear;
if Assigned(WebBrowser1.Document) then
begin
iall := (WebBrowser1.Document AS IHTMLDocument2).body;
while iall.parentElement <> nil do
begin
iall := iall.parentElement;
end;
x:= iall.outerHTML;
end;
memo1.text:=x;
if pos('BOLD',memo1.Text)>20 then siranokimlikdogrula;
end;
//Tckimlik noya göre sorgulama yapılıyorsa aşağıdaki bilgileri form nesnelerine gönder.
if buton='tckimlik' then
begin
FillForm(WebBrowser1, 'ctlIdentityNumber', edit1.Text);
FillForm(WebBrowser1, 'ctlVerify','TIKLA');//Form daki bilgileri gönderen butonun adı.
memo1.Clear;
if Assigned(WebBrowser1.Document) then
begin
iall := (WebBrowser1.Document AS IHTMLDocument2).body;
while iall.parentElement <> nil do
begin
iall := iall.parentElement;
end;
x:= iall.outerHTML;
end;
memo1.text:=x;
if pos('BOLD',memo1.Text)>20 then kimlikdogrula;
end;
end;
İçinde BOLD kelimesi bulursa aşağıdaki kod aktiv olur ve memo1'e aktarılan HTML kaynağından kişi bilgilerini alır.
Örnek kaynak kod
Kod: Tümünü seç
<TD style="WIDTH: 121px" noWrap colSpan="1" rowSpan="1">Adı:</TD>
<TD class="BOLD">
ASRİ</TD>
Kod: Tümünü seç
procedure tform1.kimlikdogrula;
begin
x:=memo1.text;
s:='';
//X deki HTML içeriğinde BOLD'un konumunu alıyor.Buna 5 ekleyerek değeri alacağı yere konumlanıyor.
i1:= pos('BOLD',x); i1:=i1+5;
while x[i1]<>'<' do begin s:=s+x[i1]; inc(i1); end;adi:=s;//Bulunan bu konumdan sonra "<" işaretine kadar değeri alıyor.
//BOLD un ilk karakterini boşluk yapıyor. Bir daha konumlanmada burası işleme dahil olmasın diye.
i1:= pos('BOLD',x);
x[i1]:=' ';
s:=''; i1:= Pos('BOLD',x); i1:=i1+5;
while x[i1]<>'<' do begin s:=s+x[i1]; inc(i1); end;soyadi:=s;
i1:= pos('BOLD',x);
x[i1]:=' ';
s:=''; i1:= Pos('BOLD',x); i1:=i1+5;
while x[i1]<>'<' do begin s:=s+x[i1]; inc(i1); end;dogumtarihi:=s;
if pos(edit1.Text,memo2.Text)=0 then
begin
//Alınan bilgiler memo2 nesnesine aktarılıyor.
memo2.lines.Append(Edit1.Text+' , '+adi+' , '+soyadi+' , '+dogumtarihi);
edit1.Refresh;
memo2.Refresh;
inc(saydir);
label21.Caption:='Kayıt Sayısı : '+inttostr(saydir);
memo2.Lines.SaveToFile(prgdizini+'Bulunanlar.csv');
end;
//İşlem tamamlandığı için twebbrowser nesnesi stop ediliyor.
webbrowser1.Stop;
end;
İli seçilinde ilçelerini getirmeyi sağlayan procedure.
Burda önemli bir nokta var. Bütün illerin ilçeleri form üzerinde
"tumilceler" isimli combobox2 de aşağıdaki şekilde tanımlı.
*ADANA
SEYHAN
MEYHAN
CEYHAN
*DİYARBAKIR
DİCLE
LİCE
MİCE
*DENİZLİ
.
.
Kod: Tümünü seç
procedure TForm1.suitemplistbox3Click(Sender: TObject);
var
I: Integer;
ilcelistesi:tstringlist;
ListboxIl, ListboxIlce: Tsuicombobox;
gec,gec1:string;
begin
edit1.Text:='';
memo2.Clear;
//Seçilen ilin adı alınıyor.
gec:=copy(ilkutusu.Text,pos('=',ilkutusu.Text)+1,length(ilkutusu.text));
ilisecti:=copy(ilkutusu.Text,1,pos('=',ilkutusu.Text)-1);
ilcekutusu.Clear;
buldu:=false;
//Tüm ilçeler içinde bu ilin adı aranıyor.
for i:=0 to tumilceler.Items.Count-1 do
begin
gec1:=tumilceler.Items.Strings[i];
//Daha önce bulmuşsam ve şimdi okuduğum ilk karakter * ise ilçe alma işlemi tamamlanmıştır.
if (gec1[1]='*') and buldu then break;
if buldu then
begin
ilcekutusu.Items.Add(gec1);
end;
//İkinci karakter itibaren hepsini al bakacaz aradığımız il mi?
gec1:=copy(gec1,2,length(gec1));
copy(gec1,pos('=',gec1)+1,length(gec1));
//Tüm ilçelerden okunan il adı ile benim aradığım il aynı ise buldu:=true;
if gec=gec1 then buldu:=true;
end;
ilcei:=0;
ilii:=ilkutusu.ItemIndex;
ilceson:= ilcekutusu.Items.Count-1;
ilison:=ilkutusu.Items.Count-1;
ilcekutusu.ItemIndex:=0;
//İlk ilçe seçilen ilçe olarak belirlendi.
ilcesecti:=copy(ilcekutusu.Text,1,pos('=',ilcekutusu.Text)-1);
ilcekutusu.Refresh;
end;
Kod: Tümünü seç
procedure TForm1.suitempButton2Click(Sender: TObject);
var
CinsiyetStr: string;
cilti,ailei,sirai:integer;
begin
memo2.Clear;
//Web sayfasının yüklenmesi tamamlandığında hangi sayfanın yüklendiğini bilmesi için.
//Alınacak değerleri buna göre belirlenecek.
buton:='birey';
hata:=false;
if (adie.Text='') or (soyadie.Text='') then begin uyari('Adı ve soyadı girmelisiniz.', mtConfirmation, [mbyes],['Tamam']);exit;end;
if (ciltno.Text='') or (aileno.Text='') or (sirano.Text='') then begin uyari('CiltNo,AileNo,SiraNo girmelisiniz.', mtConfirmation, [mbyes],['Tamam']);exit;end;
if hata then exit;
//Tckimlik doğrulama sayfası açılıyor.
webbrowser1.Navigate('http://tckimlik.nvi.gov.tr/Web/QueryIdentityNumber.aspx');
end;
Kod: Tümünü seç
procedure TForm1.suitemplistbox4Click(Sender: TObject);
begin
ilcesecti:=copy(ilcekutusu.Text,1,pos('=',ilcekutusu.Text)-1);
ilcesi:= ilcekutusu.Items.ValueFromIndex[ilcekutusu.ItemIndex];
ilcei:=ilcekutusu.ItemIndex;
end;
Kod: Tümünü seç
procedure TForm1.suitempButton3Click(Sender: TObject);
var
CinsiyetStr: string;
begin
memo2.Clear;
buton:='babaadi';
hata:=false;
giriskontrol;
if (babaadie.Text='') then begin uyari('Baba Adı girmelisiniz.', mtConfirmation, [mbyes],['Tamam']);hata:=true;end;
if (anaadie.Text='') then begin uyari('Ana Adı girmelisiniz.', mtConfirmation, [mbyes],['Tamam']);hata:=true;end;
if (cinsiyetkutu.Text='') then begin uyari('Cinsiyet Seçmelisiniz.', mtConfirmation, [mbyes],['Tamam']);hata:=true;end;
if (edit13.Value=0) then begin uyari('Doğum Tarihi girmelisiniz.', mtConfirmation, [mbyes],['Tamam']);hata:=true;end;
if hata then exit;
durdur:=false;
webbrowser1.Navigate('http://tckimlik.nvi.gov.tr/Web/QueryIdentityNumber.aspx');
end;
//Durdur butonuna basıldığın işlemleri kesmek için.
Kod: Tümünü seç
procedure TForm1.suitempdurdurbtnClick(Sender: TObject);
begin
webbrowser1.Stop;
durdur:=true;
end;
bu function ile doğru yazılıp yazılmadığı kontrol ediliyor.
Kod: Tümünü seç
Function tcvalid(tcId: String):Boolean;
Var
tmp, tmp1,
odd_sum, even_sum,
ChkDigit2, ChkDigit1,
total : Int64;
d : Array[01..11] of Int64;
n : Integer;
begin
if Length(tcId) <> 11 then Result := False
else
begin
tmp := Trunc(StrToInt64(tcId) / 100);
tmp1 := Trunc(StrToInt64(tcId) / 100);
for n := 1 to 9 do
begin
d[n] := tmp1 mod 10;
tmp1 := Trunc(tmp1 / 10);
end;
odd_sum := d[9]+d[7]+d[5]+d[3]+d[1];
even_sum := d[8]+d[6]+d[4]+d[2];
total := (odd_sum * 3) + even_sum;
ChkDigit1 := (10 - (total mod 10)) mod 10;
odd_sum := ChkDigit1+d[8]+d[6]+d[4]+d[2];
even_sum := d[9]+d[7]+d[5]+d[3]+d[1];
total := (odd_sum * 3) + even_sum;
ChkDigit2 := (10 - (total mod 10)) mod 10;
tmp := (tmp*100)+(ChkDigit1*10)+ChkDigit2;
if NOT (tmp = StrToInt64(tcId))
then Result := False
else Result := True;
end;
end;
Kod: Tümünü seç
procedure TForm1.tcsorgulabtnClick(Sender: TObject);
begin
memo2.Clear;
buton:='tckimlik';
hata:=false;
if (edit1.Text='') then begin uyari('TCKimlik Numarası girmelisiniz.', mtConfirmation, [mbyes],['Tamam']);exit;end;
if not tcvalid(edit1.text) then begin uyari('TCKimlik Numarası geçersiz.', mtConfirmation, [mbyes],['Tamam']);exit;end;
buldu:=false;
tamsay:=0;
webbrowser1.Navigate('http://tckimlik.nvi.gov.tr/Web/VerifyIdentityNumber.aspx');
end;
Kod: Tümünü seç
procedure tform1.siranokimlikdogrula;
begin
x:=memo1.text;
s:='';
i1:= pos('BOLD',x); //BOLD kelimesinin konumu bulunuyor.
while x[i1]<>'>' do i1:=i1+1; //Bilginin alınacağı yerin başına kadar gidiliyor.">"
i1:=i1+1;
while x[i1]<>'<' do begin s:=s+x[i1]; inc(i1); end;tckimlik:=s;//Bilgi alınıyor. "<" işaretine kadar.
i1:= pos('BOLD',x);
x[i1]:=' ';
i1:= pos('BOLD',x);
x[i1]:=' ';
s:='';
i1:= pos('BOLD',x);
while x[i1]<>'>' do i1:=i1+1;
i1:=i1+1;
while x[i1]<>'<' do begin s:=s+x[i1]; inc(i1); end;il:=s;
i1:= pos('BOLD',x);
x[i1]:=' ';
s:='';
i1:= pos('BOLD',x);
while x[i1]<>'>' do i1:=i1+1;
i1:=i1+1;
while x[i1]<>'<' do begin s:=s+x[i1]; inc(i1); end;ilce:=s;
i1:= pos('BOLD',x);
x[i1]:=' ';
s:='';
i1:= pos('BOLD',x);
while x[i1]<>'>' do i1:=i1+1;
i1:=i1+1;
while x[i1]<>'<' do begin s:=s+x[i1]; inc(i1); end;adi:=s;
i1:= pos('BOLD',x);
x[i1]:=' ';
s:=''; i1:= Pos('BOLD',x);
while x[i1]<>'>' do i1:=i1+1;
i1:=i1+1;
while x[i1]<>'<' do begin s:=s+x[i1]; inc(i1); end;soyadi:=s;
i1:= pos('BOLD',x);
x[i1]:=' ';
s:='';
i1:= pos('BOLD',x);
while x[i1]<>'>' do i1:=i1+1;
i1:=i1+1;
while x[i1]<>'<' do begin s:=s+x[i1]; inc(i1); end;mahalle:=s;
i1:= pos('BOLD',x);
x[i1]:=' ';
s:='';
i1:= pos('BOLD',x);
while x[i1]<>'>' do i1:=i1+1;
i1:=i1+1;
while x[i1]<>'<' do begin s:=s+x[i1]; inc(i1); end;babaadi:=s;
i1:= pos('BOLD',x);
x[i1]:=' ';
s:='';
i1:= pos('BOLD',x);
while x[i1]<>'>' do i1:=i1+1;
i1:=i1+1;
while x[i1]<>'<' do begin s:=s+x[i1]; inc(i1); end;ciltnostr:=s;
i1:= pos('BOLD',x);
x[i1]:=' ';
s:='';
i1:= pos('BOLD',x);
while x[i1]<>'>' do i1:=i1+1;
i1:=i1+1;
while x[i1]<>'<' do begin s:=s+x[i1]; inc(i1); end;anaadi:=s;
i1:= pos('BOLD',x);
x[i1]:=' ';
s:='';
i1:= pos('BOLD',x);
while x[i1]<>'>' do i1:=i1+1;
i1:=i1+1;
while x[i1]<>'<' do begin s:=s+x[i1]; inc(i1); end;ailenostr:=s;
i1:= pos('BOLD',x);
x[i1]:=' ';
s:='';
i1:= pos('BOLD',x);
while x[i1]<>'>' do i1:=i1+1;
i1:=i1+1;
while x[i1]<>'<' do begin s:=s+x[i1]; inc(i1); end;dogumyili:=s;
i1:= pos('BOLD',x);
x[i1]:=' ';
s:='';
i1:= pos('BOLD',x);
while x[i1]<>'>' do i1:=i1+1;
i1:=i1+1;
while x[i1]<>'<' do begin s:=s+x[i1]; inc(i1); end;bireyno:=s;
i1:= pos('BOLD',x);
x[i1]:=' ';
s:='';
i1:= pos('BOLD',x);
while x[i1]<>'>' do i1:=i1+1;
i1:=i1+1;
while x[i1]<>'<' do begin s:=s+x[i1]; inc(i1); end;cinsiyeti:=s;
i1:= pos('BOLD',x);
x[i1]:=' ';
with Memo2.Lines do
begin
Append('TC Kimlik No: ' + TCKimlik);
Append('İli : ' + il);
Append('İlçesi : ' + ilce);
Append('Mahalle : ' + mahalle);
Append('Adı : ' + adi);
Append('Soyadı : ' + soyadi);
Append('Doğum Tarihi: ' + dogumyili);
Append('Ana Adı : ' + anaadi);
Append('Baba Adı : ' + babaadi);
Append('Cinsiyeti : ' + Cinsiyeti);
Append('Cilt No : ' + Ciltnostr);
Append('Aile No : ' + ailenostr);
Append('Birey No : ' + bireyno);
end;
memo2.Refresh;
webbrowser1.Stop;
end;
Kod: Tümünü seç
procedure TForm1.WebBrowser1ProgressChange(Sender: TObject; Progress,
ProgressMax: Integer);
begin
if ProgressMax = 0 then
begin
Exit;
end;
try
if (Progress <> -1) and (Progress <= ProgressMax) then
progressbar1.Position:= (Progress * 100) div ProgressMax
else
progressbar1.Position:=0;
except
on EDivByZero do Exit;
end;
end;