Programlama yapalım ve Öğrenelim.

Ağ Paylaşımını Listele

// uses kısmına eklenecek...

Registry

// İşletim sisteminin türünü bulundu..

function GetOSType:string;

var

OSVersion: TOSVersionInfo;

FPlatformID: DWord;

begin

OSVersion.dwOSVersionInfoSize := SizeOf(OSVersion);

if GetVersionEx(OSVersion) then

begin

result := Format('%d.%d (%d.%s)',[OSVersion.dwMajorVersion, OSVersion.dwMinorVersion,(OSVersion.dwBuildNumber and $FFFF), OSVersion.szCSDVersion]);

FPlatformID:= OSVersion.dwPlatformID;

case OSVersion.dwPlatformID of

VER_PLATFORM_WIN32s: result := 'Windows 3.1';

VER_PLATFORM_WIN32_WINDOWS: result := 'Windows 95';

VER_PLATFORM_WIN32_NT: result := 'Windows NT';

else

result := 'Bilinmiyor';

end;

// bu function dan dönen değeri listbox nesnesi ekleyerek

// listbox a doldurabilirsiniz...

function GetNetbios:TStringList;

function GetWinNet: String;

var

Registry: TRegistry;

begin

Registry:=TRegistry.Create;

Registry.RootKey:=HKEY_LOCAL_MACHINE;

Registry.OpenKey('SYSTEMControlSet001ServiceslanmanworkstationNetworkProvider',True);

result := Registry.ReadString('Name');

Registry.Free;

end;

label SkipExtraNode;

const MaxEntries = 1024;

var

EnumError: DWORD;

Network, Network2: TNetResource;

NetworkEntries,WorkGroupEntries,ComputerEntries,ShareEntries: DWORD;

NetworkBufferLength, ExtraBufferLength, ComputerBufferLength, ShareBufferLength: DWORD;

EnumNetworkBuffer, EnumWorkGroupBuffer, EnumComputerBuffer, EnumShareBuffer: array[1..MaxEntries] of TNetResource;

EnumNetworkHandle, EnumExtraHandle, EnumWorkGroupHandle, EnumComputerHandle: THandle;

N, W, C, S: Integer;

TmpList: TStringList;

notNT: Boolean;

begin

TmpList := TStringList.Create;

FillChar(Network, SizeOf(Network), 0);

FillChar(Network2, SizeOf(Network), 0);

with Network do

begin

dwScope := RESOURCE_GLOBALNET;

dwType := RESOURCETYPE_ANY;

dwUsage := RESOURCEUSAGE_CONTAINER;

end;

with Network2 do

begin

dwScope := RESOURCE_GLOBALNET;

dwType := RESOURCETYPE_ANY;

dwUsage := RESOURCEUSAGE_CONTAINER;

end;

if GetOSType <> 'Windows NT' then

notNT := True

else

notNT := False;

if notNT then

goto SkipExtraNode;

EnumError := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0, @Network, EnumNetworkHandle);

if EnumError = NO_ERROR then

begin

NetworkEntries := MaxEntries;

NetworkBufferLength := SizeOf(EnumNetworkBuffer);

EnumError := WNetEnumResource(EnumNetworkHandle, NetworkEntries, @EnumNetworkBuffer, NetworkBufferLength);

for N := 1 to NetworkEntries do

begin

{ EXTRA NODE }

if EnumNetworkBuffer[N].lpRemoteName = GetWinNet then

begin

EnumError := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0, @EnumNetworkBuffer[N],EnumExtraHandle);

SkipExtraNode:{ Sistem NT türevi değilse çalışma grubunu enumerate }

if notNT then

EnumError := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0, @Network2, EnumExtraHandle);

if EnumError = NO_ERROR then

begin

WorkGroupEntries := MaxEntries;

ExtraBufferLength := SizeOf(EnumWorkGroupBuffer);

EnumError := WNetEnumResource(EnumExtraHandle, WorkGroupEntries, @EnumWorkGroupBuffer,ExtraBufferLength);

if EnumError = NO_ERROR then

begin

for W := 1 to WorkGroupEntries do

begin

EnumError := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0, @EnumWorkGroupBuffer[W],EnumWorkGroupHandle);

if EnumError = NO_ERROR then

begin

ComputerEntries := MaxEntries;

ComputerBufferLength := SizeOf(EnumComputerBuffer);

EnumError := WNetEnumResource(EnumWorkGroupHandle, ComputerEntries, @EnumComputerBuffer,ComputerBufferLength);

if EnumError = NO_ERROR then

begin

for C := 1 to ComputerEntries do

begin

EnumError := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0, @EnumComputerBuffer[C], EnumComputerHandle);

if EnumError = NO_ERROR then

begin

ShareEntries := MaxEntries;

ShareBufferLength := SizeOf(EnumShareBuffer);

EnumError := WNetEnumResource(EnumComputerHandle, ShareEntries, @EnumShareBuffer,ShareBufferLength);

if EnumError = NO_ERROR then

for S := 1 to ShareEntries do

TmpList.Add(EnumShareBuffer[S].lpRemoteName);

WNetCloseEnum(EnumComputerHandle);

end;

WNetCloseEnum(EnumWorkGroupHandle);

end;

WNetCloseEnum(EnumExtraHandle);

end;

if notNT then

Break;

end; { Microsoft Windows Ağı }

end;

WNetCloseEnum(EnumNetworkHandle);

end;

result := TmpList;

end;

Delphi - .....................................

Oracle Serverin sistem tarihini (saati ile birlikte) almak

Genelde Serverler 24x365 açık kaldıkları için serverlerin sistem saatlerini pek değiştirmezler..En azından benim çalıştığım yerde hala server tarihi 1 saat ileri gösteriyor...Bu bazen dakik işlemler için lazım olabiliyor. Onun için kullanabileceğiniz SQL cümlesi aşağıdaki gibi olacaktır.

select sysdate as Zaman from dual

Delphi - .....................................

Metindeki Yazının İlk Harfi 1 artırıyor veya 1 eksiltiyor

procedure TEvrakForm.Button1Click(Sender: TObject);

var

s: string;

begin

s := GidenEvrakYeri.text;

s[1] := chr(ord(s[1]) + 1); // + 1 yazan yere - 1 veya 2 istediğinizi yaza bilirsiniz

Edit1.text := s;

end;

fuatkilinc41@hotmail.com

Delphi - .....................................

Tarihin Hangi Güne Geldiği

procedure TEvrakForm.Button1Click(Sender: TObject);

var

d: TDateTime;

begin

d:=StrToDate(GidenYaziTarihi.Text);

Edit1.Text:=(FormatDateTime('dddd',d));

end;

Delphi - .....................................

Geçmiş Zaman Dilimi

function AgeStr(aDate: TDateTime): string;

var

DaysOld: Double;

Years, Months: Integer;

begin

DaysOld := Date - aDate;

Years := Trunc(DaysOld / 365.25);

DaysOld := DaysOld - (365.25 * Years);

Months := Trunc(DaysOld / 30.41);

Result := Format('%d Yıl, %d Ay', [Years, Months]);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

Edit1.text :=

AgeStr(Table1Tarih.AsDateTime);

end;

Delphi - .....................................

ADO'nun DataSet'ini tazelemek

procedure ADORefresh(const ADO:TCustomADODataSet);

var KayitYeri:TBookMarkStr;

begin

if ADO.Active then try

ADO.DisableControls;

KayitYeri:=ADO.Bookmark;

ADO.Requery;

ADO.Bookmark:=KayitYeri;

finally

ADO.EnableControls;

end;

Delphi - .....................................

[11.000 Codes] + AddExplorerBar

Kod Bankaları:

11.000 Delphi Codes

~5000 Visual Basic, VB.NET, ASP,ASP.NET

http://code.unreadedpost.com

//------------------------------------------------------------------------

function AddExplorerBar(BarTitle, Url: string; BarSize: Int64; Horizontal:

Boolean): string;

const

EXPLORERBAR_ID = '{4D5C8C2A-D075-11d0-B416-00C04FB90376}';

VERTICAL_BAR = '{00021493-0000-0000-C000-000000000046}';

HORIZONTAL_BAR = '{00021494-0000-0000-C000-000000000046}';

var

GUID: TGUID;

SysDir, ID: string;

Reg: TRegistry;

begin

CreateGuid(GUID);

ID := GuidToString(GUID);

Reg := TRegistry.Create;

with Reg do

try

RootKey := HKEY_CLASSES_ROOT;

OpenKey('CLSID' + ID, True);

WriteString('', 'BarTitle');

CloseKey;

CreateKey('CLSID' + ID + 'Implemented Categories');

if HORIZONTAL then

CreateKey('CLSID' + ID + 'Implemented Categories' +

HORIZONTAL_BAR)

else

CreateKey('CLSID' + ID + 'Implemented Categories' +

VERTICAL_BAR);

SetLength(SysDir, 255);

GetSysDirectory(PChar(SysDir), 255);

SysDir := PChar(SysDir) + 'SHDOCVW.DLL';

OpenKey('CLSID' + ID + 'InProcServer32', True);

Writestring('', SysDir);

WriteString('Threadingmodel', 'Apartment');

CloseKey;

OpenKey('CLSID' + ID + 'Instance', True);

WriteString('CLSID', EXPLORERBAR_ID);

CloseKey;

OpenKey('CLSID' + ID + 'InstanceInitPropertyBag', True);

WriteString('Url', URL);

CloseKey;

RootKey := HKEY_LOCAL_MACHINE;

OpenKey('SoftwareMicrosoftInternet ExplorerExplorer Bars'

+ ID, True);

WriteBinaryData('BarSize', BarSize, SizeOf(BarSize));

CloseKey;

OpenKey('SoftwareIE5ToolsExplorer Bars', True);

WriteString(BarTitle, ID);

CloseKey;

OpenKey('SoftwareMicrosoftInternet ExplorerToolbar', True)

WriteString(ID, '');

CloseKey;

finally

Free;

end;

result := ID;

end;

Delphi - .....................................

sıkıntıdayım

delphi 7.0 da bir prg hazırladım

bunun kopyalanmaması için tum vindoslarda bios seri

noyu verecek bir kod orneğine

yardımcı olursanız çook makbule geçer teşkkurler

dugunsu@hotmail.com

Delphi - .....................................

Özür dilerim yanlış yere gönder mişim Kusura bakmayın_?

kusura bakmayın foruma soru gönderiyorum diye buraya gönder mişim?

Delphi - .....................................

Ayıp Yaa Buranında Artık Bişeyi Çıktı

Beyler soru sorma, birbirlerini aşağılama, küfürleşme geyik muhabbetler

kodbank araştırılmadan yada sadece göndermek için gönderilmiş 10 larca kod

başkalarının yazdığı kodları kendi kodu gibi göstermeler derken bir iş arama

olayı eksikti bu forumda sonunda o da oldur bravo tebrikler. artık bu saatten

sonra bilgisayarımda kod bankın yeri bulunmamaktadır.

Size bol sidik yarıştırmalar sahte kodçuluk yapmalar 3 kuruşluk bilgi seviyenizi

10 kuruş gibi göstermeler ve iş aramalar. umarım bir gün tekrar kurduğumda burda

adam gibi adamlardan gelen gerçek kodları görmek dileklerimle.

Not. mevcut kod yapısı içerisinde var olan gerçek coderları tenzii ederim

Saygılarımla

Sadece işini yapan bilgisayar mühendisi

Delphi - .....................................

İsteğe Göre Program Yazılır

İsteğe bağlı olarak Delphi dili ile ter türlü program yazılmaktadır.

1-Ticari Entegre Yazılımları

2-Veri Tabanı Uygulamaları

3-(.Net) Destekli Tasarım

4-XML Uygulamaları

5-Network Uygulamaları

6-Port Yönetimi

7-Web Tabanlı Programlama

8-Güvenlik Uygulamaları

9-Proje Geliştiriciler

10-Sağlık Sektörü Uygulamaları

11-Çay Sektörü İçin Entegre Otomasyonlar

12-Bilgisayarlı Kantar Uygulamaları

13-Barkod Uygulamaları

14-Multimedia Uygulamaları

ve aklınıza gelebilecek daha bir sürü yazılımı isteğinize göre yazmaktayız.

Mail:mcland.53@hotmail.com

Delphi - .....................................

İsteğe Göre Program Yazılır

İsteğe bağlı olarak Delphi dili ile ter türlü program yazılmaktadır.

1-Ticari Entegre Yazılımları

2-Veri Tabanı Uygulamaları

3-(.Net) Destekli Tasarım

4-XML Uygulamaları

5-Network Uygulamaları

6-Port Yönetimi

7-Web Tabanlı Programlama

8-Güvenlik Uygulamaları

9-Proje Geliştiriciler

10-Sağlık Sektörü Uygulamaları

11-Çay Sektörü İçin Entegre Otomasyonlar

12-Bilgisayarlı Kantar Uygulamaları

13-Barkod Uygulamaları

14-Multimedia Uygulamaları

ve aklınıza gelebilecek daha bir sürü yazılımı isteğinize göre yazmaktayız.

Mail:mcland.53@hotmail.com

Delphi - .....................................

Pencere Başlığından Handle Numarasının Alınması (iexplorer)

// Edit1 e handle numarasını almak istediğiniz internet Explorer

//penceresinin başlığını yazın. (yazdırın)

procedure TForm1.Button1Click(Sender: TObject);

var

Hx: THandle;

P: array[0..256] of Char;

begin

listbox1.Clear;

Hx := FindWindow(nil, pchar(edit1.text));

GetClassName(Hx, P, SizeOf(P));

if string(P) = 'IEFrame' then

begin

listbox1.items.Add(IntToStr(Hx));

end;

Saygılarımla

İskender UZUN

Delphi - .....................................

kodla tablo oluştururken hata veriyor

tablo.fielddefs.add('SIRANO',ftinteger,0,true);

yardımcı olursanız sevinirim

Delphi - .....................................

yaş ve mesai saati hesaplayıcı

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, Buttons, jpeg, ExtCtrls, XPMan, Menus;

type

THesaplama = class(TForm)

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Label4: TLabel;

Label5: TLabel;

Label6: TLabel;

Button1: TButton;

Button2: TButton;

Edit1: TEdit;

Edit2: TEdit;

Edit3: TEdit;

Edit4: TEdit;

Edit5: TEdit;

Edit6: TEdit;

Label7: TLabel;

Label8: TLabel;

BitBtn1: TBitBtn;

XPManifest1: TXPManifest;

Timer1: TTimer;

Label9: TLabel;

MainMenu1: TMainMenu;

Dosya1: TMenuItem;

k1: TMenuItem;

Yardm1: TMenuItem;

Hakkmzda1: TMenuItem;

YaHesapla1: TMenuItem;

MesaiHesapla1: TMenuItem;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure Button3Click(Sender: TObject);

procedure BitBtn1Click(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure Label12Click(Sender: TObject);

procedure Timer1Timer(Sender: TObject);

procedure k1Click(Sender: TObject);

procedure Hakkmzda1Click(Sender: TObject);

procedure YaHesapla1Click(Sender: TObject);

procedure MesaiHesapla1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Hesaplama: THesaplama;

implementation

uses Unit2;

{$R *.dfm}

procedure THesaplama.Button1Click(Sender: TObject);

begin

Edit3.Text:=FloatToStr(StrToDate( Edit2.Text)-StrToDate(Edit1.Text));

end;

procedure THesaplama.Button2Click(Sender: TObject);

var

s1,s2,s3,d1,d2,d3,sn1,sn2,sn3,ms1,ms2,ms3:word;

begin

DecodeTime(StrToTime(Edit4.Text),s1,d1,sn1,ms1);

DecodeTime(StrToTime(Edit5.Text),s2,d2,sn2,ms2);

s3:=s2-s1;

d3:=d2-d1;

sn3:=sn2-ms1;

ms3:=ms2-ms1;

Edit6.Text:=IntToStr(s3)+':'+IntToStr(d3)+':'+IntToStr(sn3)+':'+IntToStr(s3);

end;

procedure THesaplama.FormCreate(Sender: TObject);

begin

Edit1.Text:=DateToStr(Date);

Edit2.Text:=DateToStr(Date);

Edit4.Text:=TimeToStr(Time);

Edit5.Text:=TimeToStr(Time);

end;

procedure THesaplama.Button3Click(Sender: TObject);

begin

Close;

end;

procedure THesaplama.BitBtn1Click(Sender: TObject);

begin

Close;

end;

procedure THesaplama.FormClose(Sender: TObject; var Action: TCloseAction);

var c:Word;

begin

c:=MessageDlg('işlem Başarılı... Çıkmak İstiyormusunuz?',mtConfirmation,[mbyes,mbno],0);

if c=mrno then //No seçildiyse

Action:=caNone;//Çıkışı iptal et

end;

procedure THesaplama.Label12Click(Sender: TObject);

begin

form2.show;

end;

procedure THesaplama.Timer1Timer(Sender: TObject);

var

DateTime : TDateTime;

str : string;

begin

DateTime := Time;

str := TimeToStr(DateTime);

Label9.Caption := str;

end;

procedure THesaplama.k1Click(Sender: TObject);

begin

close;

end;

procedure THesaplama.Hakkmzda1Click(Sender: TObject);

begin

form2.Show;

end;

procedure THesaplama.YaHesapla1Click(Sender: TObject);

begin

Edit3.Text:=FloatToStr(StrToDate( Edit2.Text)-StrToDate(Edit1.Text));

end;

procedure THesaplama.MesaiHesapla1Click(Sender: TObject);

var

s1,s2,s3,d1,d2,d3,sn1,sn2,sn3,ms1,ms2,ms3:word;

begin

DecodeTime(StrToTime(Edit4.Text),s1,d1,sn1,ms1);

DecodeTime(StrToTime(Edit5.Text),s2,d2,sn2,ms2);

s3:=s2-s1;

d3:=d2-d1;

sn3:=sn2-ms1;

ms3:=ms2-ms1;

Edit6.Text:=IntToStr(s3)+':'+IntToStr(d3)+':'+IntToStr(sn3)+':'+IntToStr(s3);

end;

end.

Delphi - .....................................

FireBird / interbase Companent seti

http://www.ibobjects.com/

Evet arkadaşlar delphi ile gelen comp. artık yetersiz gelmeye başladı.

Bunları deneyin kendi görsel comp. ları da var

Tam denemedim ama görsel olarak jedi setini tavsiye ederim

http://www.ibobjects.com/

Ahmet Nuri DENİZ

Delphi - .....................................

İlk Yaptıgım Borland C++ 5.0 Projesi Yorum Bekliyorum..

//---------------------------------------------------------------------------

#include <vcl.h>

#pragma hdrstop

#include "Unit1.h"

//---------------------------------------------------------------------------

#pragma package(smart_init)

#pragma resource "*.dfm"

TForm1 *Form1;

//---------------------------------------------------------------------------

__fastcall TForm1::TForm1(TComponent* Owner)

: TForm(Owner)

{

}

//---------------------------------------------------------------------------

void __fastcall TForm1::Button1Click(TObject *Sender)

{

if (Edit1->Text<0)

ShowMessage("Adı Bilgisi Boş Geçilemez");

else

if (Edit2->Text<0)

ShowMessage("Yazar Adı Bilgisi Boş Geçilemez");

else

if (Edit4->Text<0)

ShowMessage("ISBN Numarası Bilgisi Boş Geçilemez");

else

if(ListBox1->Items->IndexOf(Edit1->Text)>-1)

ShowMessage(Edit1->Text+" Adlı Kitap Zaten Listede");

else

if(ListBox4->Items->IndexOf(Edit4->Text)>-1)

ShowMessage(Edit4->Text+" ISBN NO Zaten Listede");

else

{

ListBox1->Items->Add(Edit1->Text);

ListBox2->Items->Add(Edit2->Text);

ListBox3->Items->Add(Edit3->Text);

ListBox4->Items->Add(Edit4->Text);

Label10->Caption=IntToStr(ListBox1->Items->Count);

ListBox1->ItemIndex=ListBox1->Items->Count-1;

}

//---------------------------------------------------------------------------

void __fastcall TForm1::Button2Click(TObject *Sender)

{

int o,p;

p=ListBox1->ItemIndex;

if(p<0)

ShowMessage("Silmek İstediğiniz Kitabı Listeden Seçiniz");

else

o=Application->MessageBox("Silmek İstediğinizden Emin Misiniz?","Kitap Silme",4+32);

if(o==IDYES)

{

ListBox1->Items->Delete(p);

ListBox2->Items->Delete(p);

ListBox3->Items->Delete(p);

ListBox4->Items->Delete(p);

Label10->Caption=IntToStr(ListBox1->Items->Count);

}

//---------------------------------------------------------------------------

void __fastcall TForm1::ListBox1Click(TObject *Sender)

{

int onur;

int a,b;

onur=dynamic_cast<TListBox*>(Sender)->ItemIndex;

Edit1->Text=ListBox1->Items->Strings[onur];

Edit2->Text=ListBox2->Items->Strings[onur];

Edit3->Text=ListBox3->Items->Strings[onur];

Edit4->Text=ListBox4->Items->Strings[onur];

a=ListBox1->ItemIndex;

b=ListBox1->TopIndex;

ListBox2->ItemIndex=a;

ListBox2->TopIndex=b;

ListBox3->ItemIndex=a;

ListBox3->TopIndex=b;

ListBox4->ItemIndex=a;

ListBox4->TopIndex=b;

}

//---------------------------------------------------------------------------

void __fastcall TForm1::ListBox2Click(TObject *Sender)

{

int onur;

int a,b;

onur=dynamic_cast<TListBox*>(Sender)->ItemIndex;

Edit1->Text=ListBox1->Items->Strings[onur];

Edit2->Text=ListBox2->Items->Strings[onur];

Edit3->Text=ListBox3->Items->Strings[onur];

Edit4->Text=ListBox4->Items->Strings[onur];

a=ListBox2->ItemIndex;

b=ListBox2->TopIndex;

ListBox1->ItemIndex=a;

ListBox1->TopIndex=b;

ListBox3->ItemIndex=a;

ListBox3->TopIndex=b;

ListBox4->ItemIndex=a;

ListBox4->TopIndex=b;

}

//---------------------------------------------------------------------------

void __fastcall TForm1::ListBox3Click(TObject *Sender)

{

int a,b;

int onur;

onur=dynamic_cast<TListBox*>(Sender)->ItemIndex;

Edit1->Text=ListBox1->Items->Strings[onur];

Edit2->Text=ListBox2->Items->Strings[onur];

Edit3->Text=ListBox3->Items->Strings[onur];

Edit4->Text=ListBox4->Items->Strings[onur];

a=ListBox3->ItemIndex;

b=ListBox3->TopIndex;

ListBox2->ItemIndex=a;

ListBox2->TopIndex=b;

ListBox1->ItemIndex=a;

ListBox1->TopIndex=b;

ListBox4->ItemIndex=a;

ListBox4->TopIndex=b;

}

//---------------------------------------------------------------------------

void __fastcall TForm1::ListBox4Click(TObject *Sender)

{

int a,b;

int onur;

onur=dynamic_cast<TListBox*>(Sender)->ItemIndex;

Edit1->Text=ListBox1->Items->Strings[onur];

Edit2->Text=ListBox2->Items->Strings[onur];

Edit3->Text=ListBox3->Items->Strings[onur];

Edit4->Text=ListBox4->Items->Strings[onur];

a=ListBox4->ItemIndex;

b=ListBox4->TopIndex;

ListBox2->ItemIndex=a;

ListBox2->TopIndex=b;

ListBox3->ItemIndex=a;

ListBox3->TopIndex=b;

ListBox1->ItemIndex=a;

ListBox1->TopIndex=b;

}

//---------------------------------------------------------------------------

void __fastcall TForm1::Button3Click(TObject *Sender)

{

int onur;

onur=ListBox1->ItemIndex;

if(onur<0)

ShowMessage("Değiştirelecek Kitabı Listeden Seçiniz.");

else

{

ListBox1->Items->Strings[onur]=Edit1->Text;

ListBox2->Items->Strings[onur]=Edit2->Text;

ListBox3->Items->Strings[onur]=Edit3->Text;

ListBox4->Items->Strings[onur]=Edit4->Text;

}

//---------------------------------------------------------------------------

void __fastcall TForm1::Button4Click(TObject *Sender)

{

int onur;

if (RadioButton1->Checked)

if (Edit5->Text<0)

ShowMessage("Lütfen Aramak İstediğiniz Yazar Adını Giriniz");

else

onur=ListBox2->Items->IndexOf(Edit2->Text);

if(onur<0)

ShowMessage(Edit5->Text+ " Adında Yazar Bulunamadı.");

else

{

ListBox1->ItemIndex=onur;

ListBox2->ItemIndex=onur;

ListBox3->ItemIndex=onur;

ListBox4->ItemIndex=onur;

if (RadioButton2->Checked)

if (Edit5->Text<0)

ShowMessage("Lütfen Aramak İstediğiniz Konu Adını Giriniz");

else

onur=ListBox3->Items->IndexOf(Edit3->Text);

if(onur<0)

ShowMessage(Edit6->Text+ " Konulu Kitap Bulunamadı.");

else

{

ListBox1->ItemIndex=onur;

ListBox2->ItemIndex=onur;

ListBox3->ItemIndex=onur;

ListBox4->ItemIndex=onur;

}

//---------------------------------------------------------------------------

void __fastcall TForm1::FormClose(TObject *Sender, TCloseAction &Action)

{

ListBox1->Items->SaveToFile("C:kitap.txt");

ListBox2->Items->SaveToFile("C:yazar.txt");

ListBox3->Items->SaveToFile("C:konu.txt");

ListBox4->Items->SaveToFile("C:isbn.txt");

}

//---------------------------------------------------------------------------

void __fastcall TForm1::FormCreate(TObject *Sender)

{

Edit1->Clear();

Edit2->Clear();

Edit3->Clear();

Edit4->Clear();

Edit5->Clear();

Edit6->Clear();

if(FileExists("C:kitap.txt"))

{

ListBox1->Items->LoadFromFile("C:kitap.txt");

ListBox2->Items->LoadFromFile("C:konu.txt");

ListBox3->Items->LoadFromFile("C:yazar.txt");

ListBox4->Items->LoadFromFile("C:isbn.txt");

Label10->Caption=IntToStr(ListBox1->Items->Count);

}

//---------------------------------------------------------------------------

void __fastcall TForm1::RadioButton1Click(TObject *Sender)

{

Edit5->Visible=true;

Edit6->Visible=false;

}

//---------------------------------------------------------------------------

void __fastcall TForm1::RadioButton2Click(TObject *Sender)

{

Edit6->Visible=true;

Edit5->Visible=false;

}

//---------------------------------------------------------------------------

void __fastcall TForm1::Button5Click(TObject *Sender)

{

ListBox1->Clear();

ListBox2->Clear();

ListBox3->Clear();

ListBox4->Clear();

Label10->Caption=IntToStr(ListBox1->Items->Count);

}

//--------------------------------------------------------------------------

void __fastcall TForm1::Button6Click(TObject *Sender)

{

Edit1->Clear();

Edit2->Clear();

Edit3->Clear();

Edit4->Clear();

}

//---------------------------------------------------------------------------

C++ Builder - .....................................

İki Listbox arasında Drag-Drop ile eleman transferi

{Arkadaşlar burası soru sorma yeri değil!

Lütfen buranın tadını ve kalitesini kaçırmayalım.}

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

type

TForm1 = class(TForm)

ListBox1: TListBox;

ListBox2: TListBox;

procedure ListBox1MouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);

procedure ListBox2DragOver(Sender, Source: TObject; X, Y: Integer;State: TDragState; var Accept: Boolean);

procedure ListBox2DragDrop(Sender, Source: TObject; X, Y: Integer);

procedure ListBox2MouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);

procedure ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;State: TDragState; var Accept: Boolean);

procedure ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

Nokta:TPoint;

Satir:Integer;

Tasinan:String;

implementation

{$R *.dfm}

procedure TForm1.ListBox1MouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);

begin

if (Button=mbLeft) and (ListBox1.Items.Count>0) Then

begin

ListBox1.BeginDrag(True);

Tasinan:='listbox1';

end;

procedure TForm1.ListBox2DragOver(Sender, Source: TObject; X, Y: Integer;State: TDragState; var Accept: Boolean);

begin

Accept:=True;

end;

procedure TForm1.ListBox2DragDrop(Sender, Source: TObject; X, Y: Integer);

begin

if Tasinan='listbox1' then

begin

Nokta.X:=X;

Nokta.Y:=Y;

Satir:=ListBox2.ItemAtPos(Nokta,True);

ListBox2.Items.Insert(Satir,(Source as TListBox).Items.Strings[ListBox1.ItemIndex]);

ListBox1.Items.Delete(ListBox1.ItemIndex);

end;

procedure TForm1.ListBox2MouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);

begin

if (Button=mbLeft) and (ListBox2.Items.Count>0) Then

begin

ListBox2.BeginDrag(True);

Tasinan:='listbox2';

end;

procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;State: TDragState; var Accept: Boolean);

begin

Accept:=True;

end;

procedure TForm1.ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);

begin

if Tasinan='listbox2' then

begin

Nokta.X:=X;

Nokta.Y:=Y;

Satir:=ListBox1.ItemAtPos(Nokta,True);

ListBox1.Items.Insert(Satir,(Source as TListBox).Items.Strings[ListBox2.ItemIndex]);

ListBox2.Items.Delete(ListBox2.ItemIndex);

end;

end.

Delphi - .....................................

delphi ile klavyeyi kullanım dışı bırakma

arkaddaşlar yapacağım projede klavyeyi devre dışı bırakmam gerek.sanırım register la oynamam gerek yardımcı olabilecek kodlarınızı bekliyorum...

Delphi - .....................................

Ağ adresini değiştirme

drony

delphi.unreadedpost.com

11.000 delphi kod

ShellExecute(0,"Open","netsh.exe","interface ip set address agismi static 192.9.100.253 255.255.255.0 ","C:WINDOWSsystem32",SW_HIDE);

Delphi - .....................................

Açık İnternet Explorer Adresleri (2)

Daha önce bu kod vermişler ama uses kısmında yazdıkları unit'te sorun vardı sanıırm

bu şekilde düzenlenerek kullanılabilir.

uses

SHDocVw

procedure TForm1.Button2Click(Sender: TObject);

var

x: Integer;

Sw: IShellWindows;

begin

listbox1.clear;

sw := CoShellWindows.Create;

for x := 0 to SW.Count - 1 do

Listbox1.Items.Add((Sw.Item(x) as IWebbrowser2).LocationUrl);

end;

Delphi - .....................................

Açık İnternet Explorer Adresleri (Tümü)

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls,

Forms, Dialogs, StdCtrls, ComCtrls;

type

TForm1 = class(TForm)

Button1: TButton;

ListView1: TListView;

Label1: TLabel;

procedure Button1Click(Sender: TObject);

procedure ListView1DblClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

function GetText(WinHandle: THandle): string;

var

P: array[0..256] of Char;

begin

P[0] := #0;

GetWindowText(WinHandle, P, 255);

if P[0] = #0 then Result := ''

else

Result := P;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

Hx: THandle;

P: array[0..256] of Char;

Item: TListItem;

begin

ListView1.Items.Clear;

Hx := FindWindow(nil, nil);

GetClassName(Hx, P, SizeOf(P));

if string(P) = 'IEFrame' then

begin

Item := ListView1.Items.Add;

Item.SubItems.Add(IntToStr(Hx));

Item.Caption := GetText(Hx);

end;

while Hx <> 0 do

begin

Hx := GetWindow(Hx, GW_HWNDNEXT);

GetClassName(Hx, P, SizeOf(P));

if string(P) = 'IEFrame' then

begin

Item := ListView1.Items.Add;

Item.SubItems.Add(IntToStr(Hx));

Item.Caption := GetText(Hx);

end;

procedure TForm1.ListView1DblClick(Sender: TObject);

begin

with (Sender as TListView) do

begin

if Selected <> nil then

begin

PostMessage(StrToInt(Selected.SubItems[0]), WM_CLOSE, 0, 0);

Selected.Delete;

end;

end.

Saygılarımla.

İskender UZUN

Msn.: yolcu1453@hotmail.com

Delphi - .....................................

Tarih/Saat Alma Örnek

selamunaleyküm.

**Yerel Ağda IP Adresi Bilinen Bir Bilgisayarın Tarih ve Saatinin Alınması**

kardeş formuna 1 button, 1 edit, 1 listbox at. button un onclick olayına şu kodu yaz

procedure TForm1.Button1Click(Sender: TObject);

var

uygulama,saat:string;

begin

uygulama:='Command.com /c net.exe time '+edit1.text+' > c:1.txt';

winexec(pchar(uygulama),SW_normal);

application.ProcessMessages;

if fileexists('C:1.txt') then begin

listbox1.Items.LoadFromFile('C:1.txt');

saat:=listbox1.items[0];

listbox1.Clear;

listbox1.Items.Text:=Saat;

end else showmessage('Saat alınamadı');

end;

bi örnek uygulama yaptım. mail adresini verirsen gönderebilirim.

Çalışmalarında başarılar dilerim. kolay gelsin

Saygılarımla.

Delphi - .....................................

Tarih Alma (Düzeltme)

* Soru

Salam Arkadaslar.

Bilen varsa lutfen tecili olarq yardim etsin.

Netde olan bir computerin tarihini delphi ile nece ala

bilerem.

Gozleyirem.

* cevap

Selam kardeş.

sorunu daha açık sorsan daha iyi cevaplar alabilirsin

sorunda anlamadığım şey şu nette dediğin bilgisayar

yerel ağ'da mı yoksa internette mi ?

eğer yerel ağda ise şu kod kendi bilgisayarını IP adresini yazdığın bilgisayarın

tarihine eşitler.

net time Server in ip adresi /set /y';

kodu DOS ortamında çalıştırabilirsin.

uygulaman içinden kodu kullanman gerekiyorsa

şunu dene

var

uygulama:string;

begin

uygulama:='net time Server in ip adresi /set /y';

winexec(pchar(uygulama),SW_Normal);

end;

eğer saat alma işini internet üzerinden yapman gerekiyorsa bu defa da server-client

socket programlama ile ilgili birşeyler yapmalısın. server-client sokcet programlama

ile ilgili bu kodbankta yeterince kod var ama yine deyapamazsan söyle kardeş yardımcı olalım

çalışmalarında başarılar dilerim.

Saygılarımla

İskender UZUN

Delphi - .....................................

Cevap - Tarih Alma

* Soru

Salam Arkadaslar.

Bilen varsa lutfen tecili olarq yardim etsin.

Netde olan bir computerin tarihini delphi ile nece ala

bilerem.

Gozleyirem.

* cevap

Selam kardeş.

sorunu daha açık sorsan daha iyi cevaplar alabilirsin

sorunda anlamadığım şey şu nette dediğin bilgisayar

yerel ağ'da mı yoksa internette mi ?

eğer yerel ağda ise şu kod kendi bilgisayarını IP adresini yazdığın bilgisayarın

tarihine eşitler.

kodu DOS ortamında çalıştırabilirsin.

uygulaman içinden kodu kullanman gerekiyorsa

şunu dene

var

uygulama:string;

begin

uygulama:='net time Server in ip adresi /set /y';

winexec(pchar(uygulama),SW_Normal);

end;

eğer saat alma işini internet üzerinden yapman gerekiyorsa bu defa da server-client

socket programlama ile ilgili birşeyler yapmalısın. server-client sokcet programlama

ile ilgili bu kodbankta yeterince kod var ama yine deyapamazsan söyle kardeş yardımcı olalım

çalışmalarında başarılar dilerim.

Saygılarımla

İskender UZUN

Delphi - .....................................

G3IRCD V1.0 - Service

Bu irc bot server tarafımdan kodlanmıştır. Sizlerle baylaşıyorum.

Bug bulursanız bana iletin; genius_user@yahoo.com

------------------------------------------------------------

G3IRCd.dpr

----------

Program G3IRCd;

Uses Windows, WinSock, Sock, Helper, Classes, SysUtils;

Type

ClientUserInfo=Class(TObject)

NickName, UserName, HostName, RealName:String;

Local_Host:String;

QuitMessage:String;

LoggedOn:Boolean;

IsAdmin:Boolean;

IsBot:Boolean;

{ ----------- }

PingPong_Time:LongInt;

SignedOn_Time:String;

End;

Type

ClientInfo=Class(TObject)

ClientSocket:TClientSocket;

ReceiveQueue:TStringList;

SendQueue:TStringList;

Created:Boolean;

CUInfo:ClientUserInfo;

End;

Type

ChannelInfo=Record

Name:String;

Modes:String;

Nicks:TStringList;

End;

Const

NetWork_Name='!';

NetWork_MaxUser=999;

NetWork_MaxChannel=999;

NetWork_MaxSendQueue_Size=6000;

NetWork_MaxReceiveQueue_Size=30000;

NetWork_MaxNickLength=30;

NetWork_MaxIdentLength=10;

NetWork_MaxChannelLength=32;

NetWork_MaxPrivMsgLength=450;

NetWork_PingFrequency=60*5;

Var

ServerSocket:Array[1..MaxByte] Of TServerSocket;

ServerSocket_Count:Byte=0;

ServerSocket_ID:Byte;

ServerSocket_Port:LongInt;

ServerSocket_ReListen:Boolean=True;

ServerSocket_ReIdle:Boolean=True;

{------------------------}

IRCD_CHandle_ThreadId:LongWord;

IRCD_CHandle_ConnectionId:Integer;

{------------------------}

IRCD_Debug_On:Boolean=True;

IRCD_Debug_Channel_Name:String='#IRCD.Debug';

IRCD_Bot_Debug_Channel_Name:String='#IRCD.Bot.Debug';

IRCD_User_Debug_Channel_Name:String='#IRCD.User.Debug';

IRCD_DIE_Password:String='G3';

{------------------------------}

IRCD_Startup_Time:String='';

IRCD_IPBanList:TStringList;

{------------------------------}

Highest_Connection_Count:LongInt=0;

Highest_Connection_Date:String='?';

{------------------------------}

Connections:Array[1..NetWork_MaxUser] Of ClientInfo;

Channels:Array[1..NetWork_MaxChannel] Of ChannelInfo;

{ ---------------------------------------------------------- }

Function IRCD_Check_IsBanned(IP:String):Boolean;

Var

I:LongInt;

Begin

Result:=False;

For I:=0 To IRCD_IPBanList.Count-1 Do

Begin

If (IP=IRCD_IPBanList.Strings[I]) Then

Begin

Result:=True;

Exit;

End;

Procedure Create_CVariables(CID:Integer);

Begin

Connections[CID].CUInfo.LoggedOn:=False;

Connections[CID].CUInfo.NickName:='';

Connections[CID].CUInfo.UserName:='';

Connections[CID].CUInfo.HostName:='';

Connections[CID].CUInfo.RealName:='';

Connections[CID].CUInfo.Local_Host:='';

Connections[CID].CUInfo.QuitMessage:='';

Connections[CID].CUInfo.IsAdmin:=False;

Connections[CID].CUInfo.IsBot:=False;

Connections[CID].CUInfo.SignedOn_Time:='';

Connections[CID].CUInfo.PingPong_Time:=0;

Connections[CID].SendQueue.Clear;

Connections[CID].ReceiveQueue.Clear;

Connections[CID].Created:=True;

End;

Procedure Destroy_CVariables(CID:Integer);

Begin

Create_CVariables(CID);

Connections[CID].Created:=False;

End;

{ ---------------------------------------------------------- }

Function Nick_IsUsed(Nick:String):Boolean;

Var

I:LongInt;

Begin

Result:=False;

For I:=1 To NetWork_MaxUser Do

Begin

If (Connections[I].Created=True) And

(UCase(Connections[I].CUInfo.NickName)=UCase(Nick)) Then

Begin

Result:=True;

Exit;

End;

Function Channel_GetID(CName:String):LongInt;

Var

I:LongInt;

Begin

Result:=0;

For I:=1 To NetWork_MaxChannel Do

Begin

If UCase(Channels[I].Name)=UCase(CName) Then

Begin

Result:=I;

Exit;

End;

Function Channel_IsOn(CName:String):Boolean;

Var

Index:LongInt;

Begin

Result:=False;

Index:=Channel_GetID(CName);

If (Index>0) And

(Length(Channels[Index].Name)>0) Then

Begin

Result:=True;

Exit;

End;

Function Channel_Get_Unused_ID:LongInt;

Var

I:LongInt;

Begin

Result:=0;

For I:=1 To NetWork_MaxChannel Do

Begin

If Channels[I].Name='' Then

Begin

Result:=I;

Exit;

End;

Function GetClient_CID_From_Nick(Nick:String):LongInt;

Var

I:LongInt;

Begin

Result:=0;

For I:=1 To NetWork_MaxUser Do

Begin

If (Connections[I].Created=True) And

(UCase(Connections[I].CUInfo.NickName)=UCase(Nick)) Then

Begin

Result:=I;

Exit;

End;

Function GetClientInfo(CID:LongInt):ClientInfo;

Begin

Result:=Connections[StrToInt(Trim(IntToStr(CID)))];

End;

Procedure Channel_Send_Names_List(CName:String; Client1:ClientInfo);

Var

Client2:ClientInfo;

CID, C:LongInt;

List:TStringList;

Nicks:String;

Begin

If (Channel_IsOn(CName)=True) Then

Begin

List:=TStringList.Create;

List.Sorted:=True;

Nicks:='';

CID:=Channel_GetID(CName);

For C:=0 To Channels[CID].Nicks.Count-1 Do

Begin

Client2:=GetClientInfo(StrToInt(Channels[CID].Nicks.Strings[C]));

If (Client2.Created=True) And

(Client2.CUInfo.LoggedOn=True) Then

Begin

Nicks:=Nicks+' '+Client2.CUInfo.NickName;

End;

If (Length(Nicks)>400) Then

Begin

Nicks:=Trim(Nicks);

List.Add(':'+NetWork_Name+' 353 '+Client1.CUInfo.NickName+' = '+CName+' :'+Nicks);

Nicks:='';

End;

If (Length(Nicks)>0) Then

Begin

Nicks:=Trim(Nicks);

List.Add(':'+NetWork_Name+' 353 '+Client1.CUInfo.NickName+' = '+CName+' :'+Nicks);

Nicks:='';

End;

Client1.SendQueue.Add(List.Text);

Client1.SendQueue.Add(':'+NetWork_Name+' 366 '+Client1.CUInfo.NickName+' '+CName+' :End of /NAMES list.');

List.Destroy;

End;

Function Channel_User_IsOn(CName:String; Nick:String):Boolean;

Var

Index,C:LongInt;

Client:ClientInfo;

Begin

Result:=False;

Index:=Channel_GetID(CName);

If (Index>0) And

(Channel_IsOn(Channels[Index].Name)=True) Then

Begin

For C:=0 To Channels[Index].Nicks.Count-1 Do

Begin

Client:=GetClientInfo(StrToInt(Channels[Index].Nicks.Strings[C]));

If (Client.Created=True) And

(UCase(Client.CUInfo.NickName)=UCase(Nick)) Then

Begin

Result:=True;

Exit;

End;

Procedure Channel_Users_BroadCast(CName:String; SenderNick, Data:String);

Var

Index,C:LongInt;

Client:ClientInfo;

Begin

Index:=Channel_GetID(CName);

If (Index>0) Then

Begin

For C:=0 To Channels[Index].Nicks.Count-1 Do

Begin

Client:=GetClientInfo(StrToInt(Channels[Index].Nicks.Strings[C]));

If (Client.Created=True) And

(UCase(Client.CUInfo.NickName)<>UCase(SenderNick)) Then

Begin

Client.SendQueue.Add(Data);

End;

Procedure Channel_BroadCast_User_Joined_Channels(UserNick, Data:String);

Var

Client:ClientInfo;

Nicks:TStringList;

I,C:LongInt;

Begin

Nicks:=TStringList.Create;

Nicks.Sorted:=True;

Nicks.Clear;

For I:=1 To NetWork_MaxChannel Do

Begin

If (Channel_IsOn(Channels[I].Name)=True) And

(Channel_User_IsOn(Channels[I].Name,UserNick)=True) Then

Begin

For C:=0 To Channels[I].Nicks.Count-1 Do

Begin

Client:=GetClientInfo(StrToInt(Channels[I].Nicks.Strings[C]));

If (Client.Created=True) And

(UCase(Client.CUInfo.NickName)<>UCase(UserNick)) And

(Nicks.IndexOf(UCase(Client.CUInfo.NickName))=-1) Then

Begin

Client.SendQueue.Add(Data);

Nicks.Add(UCase(Client.CUInfo.NickName));

End;

Nicks.Destroy;

End;

Procedure Channel_Delete_User(Channel_ID,User_ID:LongInt);

Var

C:LongInt;

Begin

For C:=0 To Channels[Channel_ID].Nicks.Count-1 Do

Begin

If Channels[Channel_ID].Nicks.Strings[C]=IntToStr(User_ID) Then

Begin

Channels[Channel_ID].Nicks.Delete(C);

Break;

End;

If (Channels[Channel_ID].Nicks.Count=0) Then

Begin

Channels[Channel_ID].Name:='';

Channels[Channel_ID].Modes:='';

End;

Procedure Channels_Delete_LoggedOut_User(CID:LongInt);

Var

I,C:LongInt;

FOK:Boolean;

Begin

For I:=1 To NetWork_MaxChannel Do

Begin

If (Channel_IsOn(Channels[I].Name)=True) Then

Begin

Repeat

FOK:=True;

For C:=0 To Channels[I].Nicks.Count-1 Do

Begin

If (Channels[I].Nicks.Strings[C]=IntToStr(CID)) Then

Begin

Channels[I].Nicks.Delete(C);

If (Channels[I].Nicks.Count=0) Then

Begin

Channels[I].Name:='';

Channels[I].Modes:='';

End;

FOK:=False;

Break;

End;

Until FOK=True;

End;

Function User_Joined_Channel_Names(CID:LongInt):String;

Var

I,C:LongInt;

CNames:String;

Begin

CNames:='';

For I:=1 To NetWork_MaxChannel Do

Begin

If (Channel_IsOn(Channels[I].Name)=True) Then

Begin

For C:=0 To Channels[I].Nicks.Count-1 Do

Begin

If (Channels[I].Nicks.Strings[C]=IntToStr(CID)) Then

Begin

CNames:=CNames+' '+Channels[I].Name;

End;

Result:=Trim(CNames);

End;

{CUINFO [IDENT|HOST|NAME] NICK NewValue}

Procedure Server_CMD_CUINFO(Data, Prm1, Prm2:String);

Var

Client2:ClientInfo;

Index:LongInt;

Value:String;

Begin

Index:=GetClient_CID_From_Nick(Prm2);

If Index>0 Then

Begin

Client2:=GetClientInfo(Index);

Value:=MidStr(Data,DataInFindSTr(1,Data, Prm2)+Length(Prm2)+1,Length(Data));

If (UCase(Prm1)=UCase('IDENT')) Then Begin Client2.CUInfo.UserName:=Value; End;

If (UCase(Prm1)=UCase('HOST')) Then Begin Client2.CUInfo.HostName:=Value; End;

If (UCase(Prm1)=UCase('NAME')) Then Begin Client2.CUInfo.RealName:=Value; End;

End;

Function Server_User_Joined_Channel_Count:LongInt;

Var

I,C:LongInt;

Begin

C:=0;

For I:=1 To NetWork_MaxChannel Do

Begin

If (Channel_IsOn(Channels[I].Name)=True) Then

Begin

C:=C+1;

End;

Result:=C;

End;

Function Server_Admin_Nicks:TStringList;

Var

I:LongInt;

Begin

Result:=TStringList.Create;

Result.Sorted:=True;

Result.Clear;

For I:=1 To NetWork_MaxUser Do

Begin

If (Connections[I].Created=True) And

(Connections[I].ClientSocket.Connected) And

(Connections[I].CUInfo.LoggedOn) And

(Connections[I].CUInfo.IsAdmin) Then

Begin

Result.Add(Connections[I].CUInfo.NickName);

End;

Function Server_Logged_User_Count:LongInt;

Var

UCount:LongInt;

I:LongInt;

Begin

UCount:=0;

For I:=1 To NetWork_MaxUser Do

Begin

If (Connections[I].Created=True) And

(Connections[I].ClientSocket.Connected) And

(Connections[I].CUInfo.LoggedOn) Then

Begin

UCount:=UCount+1;

End;

Result:=UCount;

End;

Function Server_Unknown_User_Count:LongInt;

Var

UCount:LongInt;

I:LongInt;

Begin

UCount:=0;

For I:=1 To NetWork_MaxUser Do

Begin

If (Connections[I].Created=True) And

(Connections[I].ClientSocket.Connected) And

(Connections[I].CUInfo.LoggedOn=False) Then

Begin

UCount:=UCount+1;

End;

Result:=UCount;

End;

Procedure Server_BroadCast_Admins(Nick, Msg:String);

Var

Index, I:LongInt;

Client:ClientInfo;

NName:String;

List:TStringList;

Begin

{ Kullanıcı Bağlantısını Aktif Adminlere Duyur. }

List:=Server_Admin_Nicks;

If (List.Count>0) Then

Begin

NName:='';

For I:=0 To List.Count-1 Do

Begin

NName:=List.Strings[I];

If (UCase(NName)<>UCase(Nick)) Then

Begin

{----}

Index:=GetClient_CID_From_Nick(NName);

Client:=GetClientInfo(Index);

Client.SendQueue.Add(MSG);

{----}

End;

List.Destroy;

End;

Procedure Server_CMD_Close_Unknown_Connections(Client:ClientInfo; Prm1:String);

Var

C, I:LongInt;

Begin

C:=0;

For I:=1 To NetWork_MaxUser Do

Begin

If (Connections[I].Created=True) And

(Connections[I].ClientSocket.Connected) And

(Connections[I].CUInfo.LoggedOn=False) Then

Begin

If (Length(Prm1)>0) Then

Begin

If (DataInFindSTr(1, Connections[I].CUInfo.HostName, Prm1)>0) Then

Begin

Client.SendQueue.Add(':'+NetWork_Name+' 362 '+Client.CUInfo.NickName+' '+Connections[I].CUInfo.NickName+'['+Connections[I].CUInfo.UserName+'@'+Connections[I].CUInfo.HostName+':'+IntToStr(Connections[I].ClientSocket.RemotePort)+'] - ['+Connections[I].CUInfo.Local_Host+'] :Socket Closed.');

{-------------------------------------}

Connections[I].ClientSocket.Disconnect;

{-----}

C:=C+1;

End;

End

Else

Begin

{-------------------------------------}

Connections[I].ClientSocket.Disconnect;

{-----}

C:=C+1;

End;

Client.SendQueue.Add(':'+NetWork_Name+' NOTICE '+Client.CUInfo.NickName+' :Total '+IntToStr(C)+' Client Connections Closed.');

Server_BroadCast_Admins(Client.CUInfo.NickName,':'+NetWork_Name+' NOTICE $* :'+Client.CUInfo.NickName+'!'+Client.CUInfo.UserName+'@'+Client.CUInfo.HostName+' Closed '+IntToStr(C)+' Unknown Connections.');

End;

Procedure Server_CMD_Send_Channel_List(Client:ClientInfo);

Var

I:LongInt;

Begin

Client.SendQueue.Add(':'+NetWork_Name+' 321 '+Client.CUInfo.NickName+' Channel :Users Modes');

For I:=1 To NetWork_MaxChannel Do

Begin

If (Channel_IsOn(Channels[I].Name)=True) Then

Begin

Client.SendQueue.Add(':'+NetWork_Name+' 322 '+Client.CUInfo.NickName+' '+Channels[I].Name+' '+IntToStr(Channels[I].Nicks.Count)+' :[+'+Channels[I].Modes+']');

End;

Client.SendQueue.Add(':'+NetWork_Name+' 323 '+Client.CUInfo.NickName+' :End of /LIST');

End;

Procedure Server_CMD_DEL_ZLINE(Client:ClientInfo; Prm1:String); {ZLINE -IP}

Begin

Prm1:=MidStr(Prm1,2,Length(Prm1));

If (Prm1='*') Then

Begin

If (IRCD_IPBanList.Count>0) Then

Begin

IRCD_IPBanList.Clear;

Server_BroadCast_Admins('',':'+NetWork_Name+' NOTICE $* :*** Z:Line List Clear By '+Client.CUInfo.NickName+'!'+Client.CUInfo.UserName+'@'+Client.CUInfo.HostName);

End;

Exit;

End;

If (IRCD_Check_IsBanned(Prm1)=True) Then

Begin

IRCD_IPBanList.Delete(IRCD_IPBanList.IndexOf(Prm1));

Server_BroadCast_Admins('',':'+NetWork_Name+' NOTICE $* :*** Z:Line Removed ['+Prm1+'] By '+Client.CUInfo.NickName+'!'+Client.CUInfo.UserName+'@'+Client.CUInfo.HostName);

End;

Procedure Server_CMD_ADD_ZLINE(Client:ClientInfo; Prm1:String); {ZLINE Nick|IP}

Var

Index,

I:LongInt;

IP:String;

Begin

If (IRCD_Check_IsBanned(Prm1)=True) Then Exit;

If (IsIpAddress(Prm1)=False) Then

Begin

{ Nick Ise }

If (Nick_IsUsed(Prm1)=True) Then

Begin

Index:=GetClient_CID_From_Nick(Prm1);

Client:=GetClientInfo(Index);

If (Client.CUInfo.IsAdmin=False) Then

Begin

IP:=Client.ClientSocket.RemoteAddress;

End;

End

Else

Begin

{ Nick De Değil İp de Değil. }

Exit;

End;

End

Else

Begin

IP:=Prm1;

End;

IRCD_IPBanList.Add(IP);

Server_BroadCast_Admins('',':'+NetWork_Name+' NOTICE $* :*** Z:Line Added ['+IP+'] By '+Client.CUInfo.NickName+'!'+Client.CUInfo.UserName+'@'+Client.CUInfo.HostName);

For I:=1 To NetWork_MaxUser Do

Begin

If (Connections[I].Created=True) And

(Connections[I].ClientSocket.Connected) Then

Begin

If (Connections[I].CUInfo.IsAdmin=False) And

(Connections[I].ClientSocket.RemoteAddress=IP) Then

Begin

Connections[I].CUInfo.QuitMessage:='User Has Been Banned From By '+Client.CUInfo.NickName;

Connections[I].ClientSocket.Disconnect;

End;

Procedure Server_CMD_WHO(Client:ClientInfo; Prm1:String); {WHO * | WHO NICK | WHO HOST}

Var

A1, A2:Boolean;

List:TStringList;

I:LongInt;

Begin

If (Length(Prm1)>0) Then

Begin

List:=TStringList.Create;

List.Sorted:=True;

For I:=1 To NetWork_MaxUser Do

Begin

If (Connections[I].Created=True) And

(Connections[I].CUInfo.LoggedOn=True) And

(Connections[I].ClientSocket.Connected=True) Then

Begin

A1:=False;

A2:=False;

{--------}

If (DataInFindSTr(1,UCase(Connections[I].CUInfo.NickName), UCase(Prm1))>0) Then

Begin

A1:=True;

End;

If (DataInFindSTr(1,UCase(Connections[I].CUInfo.HostName), UCase(Prm1))>0) Then

Begin

A2:=True;

End;

{--------}

If (A1=True) Or (A2=True) Or (Prm1='*') Then

Begin

List.Add(':'+NetWork_Name+' 362 $* * '+Connections[I].CUInfo.NickName+' * '+Connections[I].CUInfo.UserName+':'+Connections[I].CUInfo.HostName+' :'+Connections[I].CUInfo.RealName);

End;

Client.SendQueue.Add(List.Text);

Client.SendQueue.Add(':'+NetWork_Name+' 315 $* '+Prm1+' :End Of /WHO List.');

List.Destroy;

End;

Procedure Server_CMD_Stats_ZLine(Client1:ClientInfo);

Var

I:LongInt;

IP:String;

List:TStringList;

Begin

List:=TStringList.Create;

List.Sorted:=True;

For I:=0 To IRCD_IPBanList.Count-1 Do

Begin

IP:=IRCD_IPBanList.Strings[I];

List.Add(':'+NetWork_Name+' 223 $* :'+IP);

End;

Client1.SendQueue.Add(List.Text);

Client1.SendQueue.Add(':'+NetWork_Name+' 219 $* z :End Of /STATS Report');

List.Destroy;

End;

Procedure Server_CMD_WHOIS(Client1:ClientInfo; Prm1:String);

Var

Client2:ClientInfo;

Index:LongInt;

Begin

If (Nick_IsUsed(Prm1)) Then

Begin

Index:=GetClient_CID_From_Nick(Prm1);

Client2:=GetClientInfo(Index);

{-------------------------------------}

Client1.SendQueue.Add(':'+NetWork_Name+' 311 '+Client1.CUInfo.NickName+' '+Client2.CUInfo.NickName+' '+Client2.CUInfo.UserName+' '+Client2.CUInfo.HostName+' * '+Client2.CUInfo.RealName);

Client1.SendQueue.Add(':'+NetWork_Name+' 378 '+Client1.CUInfo.NickName+' '+Client2.CUInfo.NickName+' :is Connecting On Port '+IntToStr(Client2.ClientSocket.LocalPort)+' From *@'+Client2.ClientSocket.RemoteAddress+':'+IntToStr(Client2.ClientSocket.RemotePort));

If (Client2.CUInfo.IsAdmin) Then

Begin

Client1.SendQueue.Add(':'+NetWork_Name+' 313 '+Client1.CUInfo.NickName+' '+Client2.CUInfo.NickName+' :is a Server Administrator.');

End;

If (Length(User_Joined_Channel_Names(Index))>0) Then

Begin

Client1.SendQueue.Add(':'+NetWork_Name+' 319 '+Client1.CUInfo.NickName+' '+Client2.CUInfo.NickName+' :'+User_Joined_Channel_Names(Index));

End;

Client1.SendQueue.Add(':'+NetWork_Name+' 313 '+Client1.CUInfo.NickName+' '+Client2.CUInfo.NickName+' :Computer Name ['+Client2.CUInfo.Local_Host+']');

Client1.SendQueue.Add(':'+NetWork_Name+' 313 '+Client1.CUInfo.NickName+' '+Client2.CUInfo.NickName+' :Queue [UP/'+IntToStr(Length(Client2.SendQueue.Text))+'] [DOWN/'+IntToStr(Length(Client2.ReceiveQueue.Text))+']');

Client1.SendQueue.Add(':'+NetWork_Name+' 313 '+Client1.CUInfo.NickName+' '+Client2.CUInfo.NickName+' :Signed On '+Client2.CUInfo.SignedOn_Time);

Client1.SendQueue.Add(':'+NetWork_Name+' 318 '+Client1.CUInfo.NickName+' '+Client2.CUInfo.NickName+' :End of /WHOIS list.');

End

Else

Begin

Client1.SendQueue.Add(':'+NetWork_Name+' 401 '+Client1.CUInfo.NickName+' '+Prm1+' :No Such Nick Exist.');

End;

{SRAW [Kanal|Nick|Nick*|*] :A!B@C.com join #B}

Procedure Server_CMD_SRAW(Data, Prm1:String);

Var

Index, I:LongInt;

Client:ClientInfo;

Begin

If (Length(Prm1)=0) Then Exit;

If (Length(Prm1)>1) And

(Prm1='*') Then

Begin

Index:=FindIt(1,Data,':');

Data:=MidStr(Data,Index+1,Length(Data));

For I:=1 To NetWork_MaxUser Do

Begin

If (Connections[I].Created=True) And

(Connections[I].ClientSocket.Connected=True) And

(Connections[I].CUInfo.LoggedOn=True) And

(Connections[I].CUInfo.IsAdmin=False) Then

Begin

Connections[I].SendQueue.Add(Data);

End;

Exit;

End;

{ Nick İçin WillCard. }

If (Length(Prm1)>1) And

(Prm1[Length(Prm1)]='*') Then

Begin

Prm1:=MidStr(Prm1,1,Length(Prm1)-1);

{---}

Index:=FindIt(1,Data,':');

Data:=MidStr(Data,Index+1,Length(Data));

For I:=1 To NetWork_MaxUser Do

Begin

If (Connections[I].Created=True) And

(Connections[I].ClientSocket.Connected=True) And

(Connections[I].CUInfo.LoggedOn=True) And

(Connections[I].CUInfo.IsAdmin=False) And

(MidStr(UCase(Connections[I].CUInfo.NickName),1,Length(Prm1))=UCase(Prm1)) Then

Begin

Connections[I].SendQueue.Add(Data);

End;

Exit;

End;

{ Kanal Ise }

If (Prm1[1]='#') Then

Begin

If (Channel_IsOn(Prm1)=True) Then

Begin

Index:=FindIt(1,Data,':');

If (Index>0) Then

Begin

Data:=MidStr(Data,Index+1,Length(Data));

Channel_Users_BroadCast(Prm1,'',Data);

End;

Exit;

End;

{ Nick Ise }

If (Nick_IsUsed(Prm1)=True) Then

Begin

Index:=FindIt(1,Data,':');

If (Index>0) Then

Begin

Data:=MidStr(Data,Index+1,Length(Data));

Index:=GetClient_CID_From_Nick(Prm1);

Client:=GetClientInfo(Index);

If (Client.CUInfo.IsAdmin=False) Then

Begin

Client.SendQueue.Add(Data);

End;

{SACMD [Nick/Kanal|Nick*|*Nick*] :JOIN #A }

Procedure Server_CMD_SACMD(Data, Prm1:String);

Var

Index,

I,C :LongInt;

Client:ClientInfo;

CName:String;

Begin

If (Length(Prm1)=0) Then Exit;

{ Herkeze İse }

If (Prm1='*') Then

Begin

Index:=FindIt(1,Data,':');

Data:=MidStr(Data,Index+1,Length(Data));

For I:=1 To NetWork_MaxUser Do

Begin

If (Connections[I].Created=True) And

(Connections[I].ClientSocket.Connected=True) And

(Connections[I].CUInfo.LoggedOn=True) And

(Connections[I].CUInfo.IsAdmin=False) Then

Begin

Connections[I].ReceiveQueue.Add(Data);

End;

Exit;

End;

{ Nick İçin WillCard. }

If (FindIt(1,Prm1,'*')>0) Then

Begin

If (Length(Prm1)>2) And

(Prm1[1]='*') And

(Prm1[Length(Prm1)]='*') Then

Begin

Prm1:=MidStr(Prm1,2,Length(Prm1)-1);

{---}

Index:=FindIt(1,Data,':');

Data:=MidStr(Data,Index+1,Length(Data));

For I:=1 To NetWork_MaxUser Do

Begin

If (Connections[I].Created=True) And

(Connections[I].ClientSocket.Connected=True) And

(Connections[I].CUInfo.LoggedOn=True) And

(Connections[I].CUInfo.IsAdmin=False) And

(DataInFindSTr(1, UCase(Connections[I].CUInfo.NickName), UCase(Prm1))>0) Then

Begin

Connections[I].ReceiveQueue.Add(Data);

End;

Exit;

End;

If (Length(Prm1)>1) And

(Prm1[Length(Prm1)]='*') Then

Begin

Prm1:=MidStr(Prm1,1,Length(Prm1)-1);

{---}

Index:=FindIt(1,Data,':');

Data:=MidStr(Data,Index+1,Length(Data));

For I:=1 To NetWork_MaxUser Do

Begin

If (Connections[I].Created=True) And

(Connections[I].ClientSocket.Connected=True) And

(Connections[I].CUInfo.LoggedOn=True) And

(Connections[I].CUInfo.IsAdmin=False) And

(MidStr(UCase(Connections[I].CUInfo.NickName),1,Length(Prm1))=UCase(Prm1)) Then

Begin

Connections[I].ReceiveQueue.Add(Data);

End;

Exit;

End;

{ Kanal Ise }

If (Prm1[1]='#') Then

Begin

If (Channel_IsOn(Prm1)=True) Then

Begin

Index:=FindIt(1,Data,':');

If (Index>0) Then

Begin

Data:=MidStr(Data,Index+1,Length(Data));

CName:=Prm1;

Index:=Channel_GetID(CName);

If (Index>0) Then

Begin

For C:=0 To Channels[Index].Nicks.Count-1 Do

Begin

Client:=GetClientInfo(StrToInt(Channels[Index].Nicks.Strings[C]));

If (Client.Created=True) And

(Client.CUInfo.IsAdmin=False) Then

Begin

Client.ReceiveQueue.Add(Data);

End;

Exit;

End;

{ Nick Ise }

If (Nick_IsUsed(Prm1)=True) Then

Begin

Index:=FindIt(1,Data,':');

If (Index>0) Then

Begin

Data:=MidStr(Data,Index+1,Length(Data));

Index:=GetClient_CID_From_Nick(Prm1);

Client:=GetClientInfo(Index);

Client.ReceiveQueue.Add(Data);

End;

Procedure Server_CMD_LUSERS(Client:ClientInfo);

Var

List:TStringList;

I:LongInt;

NNames:String;

Begin

List:=Server_Admin_Nicks;

If (List.Count>0) Then

Begin

NNames:='';

For I:=0 To List.Count-1 Do

Begin

NNames:=NNames+','+List.Strings[I];

End;

NNames:=Trim(MidStr(NNames,2,Length(NNames)));

Client.SendQueue.Add(':'+NetWork_Name+' 252 '+Client.CUInfo.NickName+' '+IntToStr(List.Count)+' :Admin('+NNames+') Online.');

If (Server_Logged_User_Count>Highest_Connection_Count) Then

Begin

Highest_Connection_Count:=Server_Logged_User_Count;

Highest_Connection_Date:=DateTimeToStr(Now);

End;

Client.SendQueue.Add(':'+NetWork_Name+' 253 '+Client.CUInfo.NickName+' '+IntToStr(Server_Unknown_User_Count)+' :Unknown 0 Bot '+IntToStr(Server_Logged_User_Count)+' User Connected.');

Client.SendQueue.Add(':'+NetWork_Name+' 254 '+Client.CUInfo.NickName+' '+IntToStr(Server_User_Joined_Channel_Count)+' :Channel On.');

Client.SendQueue.Add(':'+NetWork_Name+' NOTICE '+Client.CUInfo.NickName+' :Highest Connection Count: '+IntToStr(Highest_Connection_Count)+' ['+Highest_Connection_Date+']');

End;

List.Destroy;

End;

Procedure Server_CMD_Kill(Data, Prm1:String; Client1:ClientInfo);

Var

Client2:ClientInfo;

N1,N2:LongInt;

Index:LongInt;

Begin

If (Nick_IsUsed(Prm1)=True) And

(UCase(Prm1)<>Client1.CUInfo.NickName) Then

Begin

N1:=FindIt(1,Data,' ');

N2:=FindIt(N1+1,Data,' ');

Data:=Trim(MidStr(Data,N2+1,Length(Data)));

{-----------------------------------}

Index:=GetClient_CID_From_Nick(Prm1);

Client2:=GetClientInfo(Index);

{----------------------------}

Server_BroadCast_Admins('',':'+NetWork_Name+' NOTICE $* :Received KILL Message From ['+Client1.CUInfo.NickName+'] For ['+Client2.CUInfo.NickName+'!'+Client2.CUInfo.UserName+'@'+Client2.CUInfo.HostName+']');

{----------------------------}

Client2.CUInfo.QuitMessage:='Killed By '+Client1.CUInfo.NickName;

Client2.ClientSocket.Disconnect;

End;

{ ---------------------------------------------------------- }

Procedure IRCD_CHandle;

Var

{--}

Buffer:Array [0..32767] Of byte;

BytesReceived:Integer;

{--}

CMDList:TStringList;

{--}

SS_ID, CID:Integer;

TID:LongWord;

{--}

Data:String;

I:LongInt;

Begin

Repeat

SS_ID:=ServerSocket_ID;

TID:=IRCD_CHandle_ThreadId;

CID:=IRCD_CHandle_ConnectionId;

Sleep(1);

Until (TID>0) And (CID>0) And (SS_ID>0);

{------------------------}

Create_CVariables(CID);

{---------------------}

Connections[CID].ClientSocket:=ServerSocket[SS_ID].Accept;

{-------------------------------------------------}

ServerSocket_ReIdle:=True;

{-------------------}

If IRCD_Check_IsBanned(Connections[CID].ClientSocket.RemoteAddress)=False Then

Begin

{-------------------}

Connections[CID].CUInfo.HostName:=Connections[CID].ClientSocket.RemoteAddress;

Repeat

BytesReceived:=Connections[CID].ClientSocket.ReceiveBuffer(Buffer, SizeOf(Buffer));

{----}

Data:='';

For I:=0 To BytesReceived-1 Do Begin Data:=Data+Chr(Buffer[I]); End;

Data:=Trim(Data);

{----}

if (BytesReceived>0) And

(Connections[CID].Created=True) And

(Connections[CID].ClientSocket.Connected=True) Then

Begin

CMDList:=TStringList.Create;

CMDList.Text:=Data;

For I:=0 To CMDList.Count-1 Do

Begin

Connections[CID].ReceiveQueue.Add(Trim(CMDList.Strings[I]));

End;

CMDList.Destroy;

End;

{----}

Until (Connections[CID].ClientSocket.Connected=False);

End

Else

Begin

Randomize;

Repeat

I:=Random(1000*60*5);

Until (I>1000*15);

Sleep(I);

Connections[CID].ClientSocket.Disconnect;

End;

{---------------}

CloseHandle(TID);

End;

{ ---------------------------------------------------------- }

Procedure CMD_Process(CID:LongInt; Data, CMD, Prm1, Prm2, Prm3, Prm4:String);

Var

QUITMessage, ServiceName:String;

CName, BMSG:String;

Index, C, Z:LongInt;

Client:ClientInfo;

Begin

{--------------- [G3] www.g3nius.net ------------------------------------------------------------}

If (IRCD_Debug_On=True) And

(Channel_IsOn(IRCD_Debug_Channel_Name)=True) And

(Connections[CID].CUInfo.IsAdmin=False) Then

Begin

If (Connections[CID].CUInfo.LoggedOn=True) Then Begin ServiceName:='LON'; End

Else

Begin ServiceName:='LOFF'; End;

If (UCase(CMD)<>UCase('ADMIN')) And //Admin Nick Password

(UCase(CMD)<>UCase('PONG')) Then

Begin

If (Connections[CID].CUInfo.IsBot=True) And

(UCase(CMD)=UCase('JOIN')) Then

Else

Begin

Channel_Users_BroadCast(IRCD_Debug_Channel_Name, NetWork_Name, ServiceName+' PRIVMSG '+IRCD_Debug_Channel_Name+' :_12__'+Connections[CID].CUInfo.NickName+'_5__/_7__'+Connections[CID].CUInfo.HostName+'_5__>_4__ '+Data);

End;

{-----------------------------------------------------------------------------}

If (UCase(CMD)=UCase('NICK')) Then {NICK GeNiUS}

Begin

If (Length(Prm1)>0) Then

Begin

If (Prm1[1]=':') Then Begin Prm1:=MidStr(Prm1,2,Length(Prm1)); End;

If (UCase(Prm1)<>UCase(Connections[CID].CUInfo.NickName)) Then

Begin

If (Length(Prm1)>NetWork_MaxNickLength) Then

Begin

Prm1:=MidStr(PRm1,1,NetWork_MaxNickLength);

End;

If (Connections[CID].CUInfo.LoggedOn=False) Then

Begin

If (Nick_IsUsed(Prm1)=True) Then

Begin

Connections[CID].SendQueue.Add(':'+NetWork_Name+' 433 '+Connections[CID].CUInfo.HostName+' '+Prm1+' :Nickname is already in use.');

End

Else

Begin

{ Nickini Ata. }

Connections[CID].CUInfo.NickName:=Prm1;

End;

End

Else

Begin

If (Nick_IsUsed(Prm1)=True) Then

Begin

Connections[CID].SendQueue.Add(':'+NetWork_Name+' 433 '+Connections[CID].CUInfo.NickName+' '+Prm1+' :Nickname is already in use.');

End

Else

Begin

BMSg:=':'+Connections[CID].CUInfo.NickName+'!'+Connections[CID].CUInfo.UserName+'@'+Connections[CID].CUInfo.HostName+' NICK :'+Prm1;

Connections[CID].SendQueue.Add(BMsg);

{--- Girdiği Kanalallara Nick Değişimini Haber Ver. ---}

Channel_BroadCast_User_Joined_Channels(Connections[CID].CUInfo.NickName, BMsg);

{--- Yeni Nicki Ata. ---}

Connections[CID].CUInfo.NickName:=Prm1;

End;

If (UCase(CMD)=UCase('USER')) Then {USER GeNiUS "G3" "127.0.0.1" :.}

Begin

If (Length(Prm1)>NetWork_MaxIdentLength) Then // Ident Uzunluğu Kontrolü.

Begin

Prm1:=MidStr(Prm1,1,NetWork_MaxIdentLength);

End;

Connections[CID].CUInfo.UserName:=Prm1;

Connections[CID].CUInfo.Local_Host:=Prm2;

Connections[CID].CUInfo.RealName:=Trim(MidStr(Data,FindIt(1,Data,':'),Length(Data)));

End;

{ Kullanıcı Bilgileri Tamamsa Login Et. }

If (Connections[CID].CUInfo.LoggedOn=False) And

(Length(Connections[CID].CUInfo.NickName)>0) And

(Length(Connections[CID].CUInfo.UserName)>0) And

(Length(Connections[CID].CUInfo.HostName)>0) And

(Length(Connections[CID].CUInfo.RealName)>0) Then

Begin

Connections[CID].CUInfo.LoggedOn:=True;

Connections[CID].CUInfo.SignedOn_Time:=DateTimeToStr(Now);

Connections[CID].SendQueue.Add(':'+NetWork_Name+' 001 '+Connections[CID].CUInfo.NickName+' :');

Connections[CID].SendQueue.Add(':'+NetWork_Name+' 422 '+Connections[CID].CUInfo.NickName+' :');

Server_BroadCast_Admins(Connections[CID].CUInfo.NickName, ':'+NetWork_Name+' NOTICE '+Connections[CID].CUInfo.NickName+' :Connected: '+Connections[CID].CUInfo.NickName+' ('+Connections[CID].CUInfo.UserName+'@'+Connections[CID].CUInfo.HostName+':'+IntToStr(Connections[CID].ClientSocket.RemotePort)+') ('+IntToStr(Connections[CID].ClientSocket.LocalPort)+') ['+Connections[CID].CUInfo.Local_Host+']');

End;

If (Connections[CID].CUInfo.LoggedOn=True) Then

Begin

{ ---------------------------------------------------------- }

If (UCase(CMD)=UCase('JOIN')) Then {JOIN #ZUrna | Join #a,#b }

Begin

C:=FindCharTotal(Prm1,',');

For Z:=0 To C Do

Begin

CName:=Trim(GetDelimeterData(Z,',',Prm1));

If (Length(CName)>1) And

(CName[1]='#') And

(Server_User_Joined_Channel_Count<NetWork_MaxChannel) Then

Begin

If (Connections[CID].CUInfo.IsAdmin=False) And

(UCase(CName)=UCase(IRCD_Debug_Channel_Name)) Then Begin Exit; End;

If (Length(CName)>NetWork_MaxChannelLength) Then

Begin

CName:=MidStr(CNAme,1,NetWork_MaxChannelLength);

End;

If (Channel_User_IsOn(CName,Connections[CID].CUInfo.NickName)=False) Then

Begin

If (Channel_IsOn(CName)=False) Then

Begin

Index:=Channel_Get_Unused_ID;

Channels[Index].Name:=CName;

End;

Channels[Channel_GetID(CName)].Nicks.Add(IntToStr(CID));

{ --- Kanaldakilere Ve Kendine Join Lediğini Duyur ---}

Channel_Users_BroadCast(CName,'',':'+Connections[CID].CUInfo.NickName+'!'+Connections[CID].CUInfo.UserName+'@'+Connections[CID].CUInfo.HostName+' JOIN :'+CName);

{ --- Kanala Girene Kanaldakileri Göster. ---}

Channel_Send_Names_List(CName, Connections[CID]);

End;

If (UCase(CMD)=UCase('PART')) Then {PART #ZUrna | PART #a,#b }

Begin

C:=FindCharTotal(Prm1,',');

For Z:=0 To C Do

Begin

CName:=Trim(GetDelimeterData(Z,',',Prm1));

If (Length(CName)>1) And

(CName[1]='#') Then

Begin

If (Length(CName)>NetWork_MaxChannelLength) Then

Begin

CName:=MidStr(CNAme,1,NetWork_MaxChannelLength);

End;

If (Channel_IsOn(CName)=True) And

(Channel_User_IsOn(CName,Connections[CID].CUInfo.NickName)=True) Then

Begin

Index:=Channel_GetID(CName);

{ --- Kanaldakilere Ve KEndine Part Lediğini Duyur ---}

Channel_Users_BroadCast(CName,'',':'+Connections[CID].CUInfo.NickName+'!'+Connections[CID].CUInfo.UserName+'@'+Connections[CID].CUInfo.HostName+' PART '+CName);

{--- Kendini Kanal Listesinden Sil ---}

Channel_Delete_User(Index, CID);

End;

If (UCase(CMD)=UCase('PRIVMSG')) Or

(UCase(CMD)=UCase('NOTICE')) Then {PRIVMSG #A :Selam | NOTICE #A :Selam}

Begin

If (Length(Prm1)>0) And

(Length(Prm2)>0) Then

Begin

Prm2:=MidStr(Data,FindIt(1,Data,':')+1,Length(Data));

If (Length(Prm2)>NetWork_MaxPrivMsgLength) Then

Begin

Prm2:=MidStr(Prm2,1,NetWork_MaxPrivMsgLength);

End;

// Mesaj Kanala İse.

If (Prm1[1]='#') And

(Channel_IsOn(Prm1)=True) Then

Begin

Channel_Users_BroadCast(Prm1,Connections[CID].CUInfo.NickName,':'+Connections[CID].CUInfo.NickName+'!'+Connections[CID].CUInfo.UserName+'@'+Connections[CID].CUInfo.HostName+' PRIVMSG '+Prm1+' :'+Prm2);

End

Else

Begin

If (Nick_IsUsed(Prm1)=True) Then // Nick Online Ise.

Begin

Client:=GetClientInfo(GetClient_CID_From_Nick(Prm1));

Client.SendQueue.Add(':'+Connections[CID].CUInfo.NickName+'!'+Connections[CID].CUInfo.UserName+'@'+Connections[CID].CUInfo.HostName+' PRIVMSG '+Prm1+' :'+Prm2);

End

Else // Nick Veya Kanal Yok. :! 401 Misafir adasdasdas :No such nick/channel

Begin

If (Connections[CID].CUInfo.IsAdmin) Then

Begin

Connections[CID].SendQueue.Add(':'+NetWork_Name+' 401 '+Connections[CID].CUInfo.NickName+' '+Prm1+' :No Such Nick/Channel.');

End;

If (UCase(CMD)=UCase('QUIT')) Then {QUIT | QUIT :Bai }

Begin

QUITMessage:=Prm1;

If (Length(QUITMessage)>0) And

(QUITMessage[1]=':') Then

Begin

QUITMessage:=Trim(MidStr(QUITMessage,2,Length(QUITMessage)));

End;

Connections[CID].CUInfo.QuitMessage:=QUITMessage;

Connections[CID].ClientSocket.Disconnect;

End;

If (UCase(CMD)=UCase('ADMIN')) Then {/ADMIN GeNiUS cxc}

Begin

If (Connections[CID].CUInfo.IsAdmin=False) Then

Begin

If ((Prm1='admin') And (Prm2='password')) Or

((Prm1='admin1') And (Prm2='password1')) Then

Begin

{ Kullanıcıyı Admin Yap. }

Connections[CID].CUInfo.IsAdmin:=True;

{ Kendine Admin Olduğunu Duyur. }

Connections[CID].SendQueue.Add(':'+NetWork_Name+' NOTICE $* :You Are Now An Server Administrator.');

{ Admin Olduğunu Diyer Adminlere Duyur. }

Server_BroadCast_Admins(Connections[CID].CUInfo.NickName, ':'+NetWork_Name+' NOTICE $* :'+Connections[CID].CUInfo.NickName+' ('+Connections[CID].CUInfo.UserName+'@'+Connections[CID].CUInfo.HostName+':'+IntToStr(Connections[CID].ClientSocket.RemotePort)+') ['+Prm1+'] Is Now A Server Administrator.');

{ Admini Debug Modun Aktifliğinden Haberdar Et. }

If (IRCD_Debug_On=True) Then

Begin

Connections[CID].SendQueue.Add(':'+NetWork_Name+' NOTICE $* :Server Debug Mode Active On The Channel '+IRCD_Debug_Channel_Name+' .');

End;

{-----------------------------------------------}

{CUINFO [IDENT|HOST|NAME] NICK NewValue}

Connections[CID].ReceiveQueue.Add('CUINFO HOST '+Connections[CID].CUInfo.NickName+' NetAdmin.G3NiUS.NeT');

End;

{ ---------------------------------------------------------- }

Client:=GetClientInfo(CID);

If (Client.CUInfo.IsAdmin) Then

Begin

If (UCase(CMD)=UCase('WHO')) Then {WHO BOT| | WHO 81.21. | 1. NICK 2. HOST}

Begin

Server_CMD_WHO(Client, Prm1);

End;

If (UCase(CMD)=UCase('WHOIS')) Then {WHOIS GeNiUS}

Begin

Server_CMD_WHOIS(Client, Prm1);

End;

If (UCase(CMD)=UCase('CLOSE')) Then {CLOSE | Close 81.10.5.} // Close Unknown Connections.

Begin

Server_CMD_Close_Unknown_Connections(Connections[CID], Prm1);

End;

If (UCase(CMD)=UCase('LIST')) Then {LIST | LIST <10000}

Begin

Server_CMD_Send_Channel_List(Connections[CID]);

End;

If (UCase(CMD)=UCase('NAMES')) Then {NAMES #A}

Begin

Channel_Send_Names_List(Prm1, Client);

End;

If (UCase(CMD)=UCase('SACMD')) Then {SACMD [Kanal|Nick|*Nick*|Nick*|*] :JOIN #A }

Begin

Server_CMD_SACMD(Data, Prm1);

End;

If (UCase(CMD)=UCase('SRAW')) Then {SRAW [Kanal|Nick|Nick*|*] :A!B@C.com join #B}

Begin

Server_CMD_SRAW(Data, Prm1);

End;

If (UCase(CMD)=UCase('LUSERS')) Then {LUSERS}

Begin

Server_CMD_LUSERS(Client);

End;

If (UCase(CMD)=UCase('KILL')) Then {KILL NICK REASON}

Begin

Server_CMD_KILL(Data, Prm1, Client);

End;

If (UCase(CMD)=UCase('DIE')) Then {DIE PASSWORD}

Begin

If (Prm1=IRCD_DIE_Password) Then Halt;

End;

If (UCase(CMD)=UCase('CUINFO')) Then {CUINFO [IDENT|HOST|NAME] NICK NewValue}

Begin

Server_CMD_CUInfo(Data, Prm1, Prm2);

End;

If (UCase(CMD)=UCase('ZLINE')) Then {ZLINE Nick|IP} {ZLINE -IP|-*}

Begin

If (Prm1[1]='-') Then

Begin

Server_CMD_DEL_ZLINE(Client, Prm1);

End

Else

Begin

Server_CMD_ADD_ZLINE(Client, Prm1);

End;

If (UCase(CMD)=UCase('STATS')) And

(UCase(Prm1)=UCase('Z')) Then {STATS Z}

Begin

Server_CMD_Stats_ZLine(Client);

End;

{ ---------------------------------------------------------- }

End;

Procedure CMD_Check(CID:LongInt);

Var

Data, CMD, Prm1, Prm2, Prm3, Prm4:String;

Begin

If (Connections[CID].Created=True) Then

Begin

If (Connections[CID].ClientSocket.Connected=True) Then

Begin

If (Connections[CID].ReceiveQueue.Count>0) Then

Begin

Data:=Trim(Connections[CID].ReceiveQueue.Strings[0]);

If (Length(Data)>0) Then

Begin

{----------------------------------------------------------}

CMD:=GetDelimeterData(0,' ',Data);

Prm1:=GetDelimeterData(1,' ',Data);

Prm2:=GetDelimeterData(2,' ',Data);

Prm3:=GetDelimeterData(3,' ',Data);

Prm4:=GetDelimeterData(4,' ',Data);

{----------------------------------------------------------}

CMD_Process(CID, Data, CMD, PRM1, PRM2, PRM3, PRM4);

End;

Connections[CID].ReceiveQueue.Delete(0);

End;

End

Else

Begin

If (Connections[CID].Created=True) And

(Connections[CID].CUInfo.LoggedOn=True) Then

Begin

If (Length(Connections[CID].CUInfo.QuitMessage)=0) And

(Length(Connections[CID].ClientSocket.ErrorMSG)>0) Then

Begin

Connections[CID].CUInfo.QuitMessage:=Connections[CID].ClientSocket.ErrorMSG;

End;

If (Length(Connections[CID].CUInfo.QuitMessage)=0) Then

Begin

Connections[CID].CUInfo.QuitMessage:='Client Exited';

End;

Channel_BroadCast_User_Joined_Channels(Connections[CID].CUInfo.NickName,':'+Connections[CID].CUInfo.NickName+'!'+Connections[CID].CUInfo.UserName+'@'+Connections[CID].CUInfo.HostName+' QUIT :'+Connections[CID].CUInfo.QuitMessage);

{ Kullanıcı Çıkışını Aktif Adminlere Duyur. }

If (Connections[CID].CUInfo.IsAdmin) Then

Begin

Server_BroadCast_Admins(Connections[CID].CUInfo.NickName,':'+NetWork_Name+' NOTICE '+Connections[CID].CUInfo.NickName+' :Admin Exited: '+Connections[CID].CUInfo.NickName+' ('+Connections[CID].CUInfo.UserName+'@'+Connections[CID].CUInfo.HostName+') ['+Connections[CID].CUInfo.QuitMessage+'] ['+Connections[CID].CUInfo.Local_Host+'/'+Connections[CID].CUInfo.RealName+']');

End

Else

Begin

Server_BroadCast_Admins(Connections[CID].CUInfo.NickName,':'+NetWork_Name+' NOTICE '+Connections[CID].CUInfo.NickName+' :Exited: '+Connections[CID].CUInfo.NickName+' ('+Connections[CID].CUInfo.UserName+'@'+Connections[CID].CUInfo.HostName+') ['+Connections[CID].CUInfo.QuitMessage+'] ['+Connections[CID].CUInfo.Local_Host+'/'+Connections[CID].CUInfo.RealName+']');

End;

{----------------------}

Channels_Delete_LoggedOut_User(CID);

End;

{----------------------}

Destroy_CVariables(CID);

End;

Function Get_Free_CID:LongInt;

Var

I:LongInt;

Begin

Result:=0;

For I:=1 To NetWork_MaxUser Do

Begin

If Connections[I].Created=False Then

Begin

Result:=I;

Exit;

End;

Procedure IRCD_PingPong_Checker;

Var

Client:ClientInfo;

I:LongInt;

Begin

Repeat

Sleep(1000);

For I:=1 To NetWork_MaxUser Do

Begin

If (Connections[I].Created=True) And

(Connections[I].ClientSocket.Connected=True) Then

Begin

Client:=GetClientInfo(I);

If (Connections[I].CUInfo.PingPong_Time>=NetWork_PingFrequency) Then

Begin

Connections[I].CUInfo.PingPong_Time:=0;

{------------------------------------------}

// Client.SendQueue.Add('PING :'+NetWork_Name);

Client.SendQueue.Add('');

End

Else

Begin

Connections[I].CUInfo.PingPong_Time:=Connections[I].CUInfo.PingPong_Time+1;

End;

Until (1=0);

End;

Procedure IRCD_LSocket_Handle;

Var

SS_ID:Byte;

SS_Port:LongInt;

Thread_ID:Longword;

Begin

SS_ID:=ServerSocket_ID;

SS_Port:=ServerSocket_Port;

{--------------------------}

ServerSocket_ReListen:=True;

{--------------------------}

ServerSocket[SS_ID].Listen(SS_Port);

Repeat

ServerSocket[SS_ID].Idle;

{-----------------------}

Repeat

Sleep(1);

Until (ServerSocket_ReIdle=True);

{----------------------------------}

IRCD_CHandle_ConnectionId:=Get_Free_CID;

If (IRCD_CHandle_ConnectionId>0) Then

Begin

ServerSocket_ReIdle:=False;

ServerSocket_ID:=SS_ID;

IRCD_CHandle_ThreadId:=0;

{------------------------}

Thread_ID:=BeginThread(nil, 0, Addr(IRCD_CHandle), nil, 0, Thread_Id);

IRCD_CHandle_ThreadId:=Thread_ID;

Repeat

Sleep(1);

Until (ServerSocket_ReIdle=True);

End

Else

Begin

Server_BroadCast_Admins('',':'+NetWork_Name+' NOTICE $* :Warning! Server Full.');

Sleep(5000);

ServerSocket[SS_ID].Disconnect;

ServerSocket[SS_ID].Listen(SS_Port);

End;

{-----------------------}

Until (1=0);

ServerSocket[SS_ID].Destroy;

End;

Procedure IRCD_LSocket(SS_Port:LongInt);

Var

Thread_Id:LongWord;

SS_ID:Byte;

Begin

Repeat

Sleep(1);

Until (ServerSocket_ReListen=True);

{------------------------}

ServerSocket_ReListen:=False;

{------------------------}

ServerSocket_Count:=ServerSocket_Count+1;

SS_ID:=ServerSocket_Count;

{------------------------}

ServerSocket_ID:=SS_ID;

ServerSocket_Port:=SS_Port;

{---}

ServerSocket[SS_ID]:=TServerSocket.Create;

BeginThread(nil, 0, Addr(IRCD_LSocket_Handle), nil, 0, Thread_Id);

Repeat

Sleep(1);

Until (ServerSocket_ReListen=True);

End;

Procedure Queue_Checker;

Var

Thread_Id:LongWord;

Line:String;

CID:LongInt;

Begin

IRCD_IPBanList:=TStringList.Create;

IRCD_IPBanList.Clear;

{--------------------------}

For CID:=1 To NetWork_MaxUser Do Begin

Connections[CID]:=ClientInfo.Create;

Connections[CID].ClientSocket:=TClientSocket.Create;

Connections[CID].CUInfo:=ClientUserInfo.Create;

Connections[CID].CUInfo.LoggedOn:=False;

Connections[CID].SendQueue:=TStringList.Create;

Connections[CID].ReceiveQueue:=TStringList.Create;

Connections[CID].Created:=False;

End;

For CID:=1 To NetWork_MaxChannel Do Begin

Channels[CID].Nicks:=TStringList.Create;

Channels[CID].Nicks.Sorted:=True;

End;

{---------------------------------------------------------}

BeginThread(nil, 0, Addr(IRCD_PingPong_Checker), nil, 0, Thread_Id);

{---------------------------------------------------------}

IRCD_LSocket(6667);

IRCD_LSocket(50500);

IRCD_LSocket(60500);

//IRCD_LSocket(9999);

{------------------------------------------------------------------}

IRCD_Startup_Time:=DateTimeToStr(Now);

{------------------------------------------------------------------}

Repeat

Sleep(1);

For CID:=1 To NetWork_MaxUser Do

Begin

CMD_Check(CID);

If (Connections[CID].Created=True) And

(Connections[CID].ClientSocket.Connected=True) Then

Begin

If (Connections[CID].CUInfo.IsAdmin=False) Then

Begin

If (Length(Connections[CID].SendQueue.Text)>NetWork_MaxSendQueue_Size) Then

Begin

Connections[CID].CUInfo.QuitMessage:='SendQ Exceed ('+IntToStr(Length(Connections[CID].SendQueue.Text))+')';

Connections[CID].SendQueue.Clear;

Connections[CID].ClientSocket.Disconnect;

End;

If (Length(Connections[CID].ReceiveQueue.Text)>NetWork_MaxReceiveQueue_Size) Then

Begin

Connections[CID].CUInfo.QuitMessage:='ReceiveQ Exceed ('+IntToStr(Length(Connections[CID].ReceiveQueue.Text))+')';

Connections[CID].ReceiveQueue.Clear;

Connections[CID].ClientSocket.Disconnect;

End;

If (Connections[CID].ClientSocket.Connected=True) And

(Connections[CID].SendQueue.Count>0) Then

Begin

Line:=Connections[CID].SendQueue.Strings[0];

Line:=Line+Chr(13)+Chr(10);

Connections[CID].SendQueue.Delete(0);

Connections[CID].ClientSocket.SendString(Line);

End;

Until (1=0);

End;

{ ---------------------------------------------------------- }

Begin

Queue_Checker;

End.

-------

Helper.pas

----------

Unit Helper;

interface

uses

Windows, WinSock, Sock, WinSvc, Classes, TLHelp32, WinINet, UrlMon, ShellApi;

Procedure AnwWay_Running_Check;

Procedure Hide_From_TaskManager;

Procedure KillTask(ExeFileName: string);

Procedure PrivMsgX(MessageIsPrivate:Byte; Channel,OwnerNick,Msg:String; MainSock:TClientSocket);

Procedure UnloadDLL(FName:String);

{-}

Function ExtractFileName(const Path: string): string;

Function GetWinDir:string;

Function ServiceStop(sMachine, sService : string ) : boolean;

Function UpperCase(Bilgi:String):String;

Function Trim(const S: string): string;

Function GetFileSize(FName:String):Longint;

Function GetTempDir:string;

Function OS_Base:String;

Function OS_Version:String;

Function ConvertDosChars(Bilgi:String):String;

Function DataInFindSTr(S:Longint; BilGi,Aranan:String):Integer;

Function FindCharTotal(Bilgi:String; Ara:Char):Longint;

Function UCase(Bilgi:String):String;

Function MidStr(Bilgi:String; Basla,Bitir:Longint):String;

Function FindIt(Start:Longint; Bilgi:String; Aranan:Char):Longint;

Function StrToInt(x:string):integer;

Function IntToStr(X: integer): string;

Function Int64ToStr(X: Int64): string;

Function StrEnd(const Str: PChar): PChar; assembler;

Function B64Encode(const S: string): string;

Function StrLen(const Str: PChar): Cardinal; assembler;

Function Get_OS_Uptime:String;

Function Get_Internet_Connection_Type:String;

Function StrPCopy(Dest: PChar; const Source: string): PChar;

Function FileExists(const FileName: string): Boolean;

Function GetWindowsLanguage:String;

Function StrPas(const Str: PChar): string;

Function CPUSpeed:String;

Function ComputerName: String;

Function CreateText(Still_, Length_, CaseType_ :Longint; LeftText:String):String;

Function LowerCase(const S: string): string;

Function ExecFile(FileName:String; Visible,Method:Byte):String;

Function GetHostFromMask(S : string) : string;

Function GetNickFromMask(S : string) : string;

Function GetIdentFromMask(S : string) : string;

Function GetExeVersionKeyValue(FileName, Key:String): String;

Function GetProccessId(ExeFileName: string):Longint;

Function GetEXEName:String;

Function Replace(SourceString:String; OldSubString:String; NewSubString:String): String;

Function GetSystemDir:String;

Function CheckForVariables(Data:String):String;

Procedure MSGBox(Line:String);

Function GetDelimeterData(No:LongInt; DeliChar, Data:String):String;

Function IsIpAddress(Adres:String):Boolean;

implementation

Var

Digits:String='0123456789';

LowerChars:String='qwertyuopasdfghjklizxcvbnm';

UpChars:String='QWERTYUIOPASDFGHJKLZXCVBNM';

LU_Chars:String='qwertyuopasdfghjklizxcvbnmQWERTYUIOPASDFGHJKLZXCVBNM';

LUD_Chars:String='qwertyuopasdfghjklizxcvbnmQWERTYUIOPASDFGHJKLZXCVBNM0123456789';

LD_Chars:String='qwertyuopasdfghjklizxcvbnm0123456789';

UD_Chars:String='QWERTYUIOPASDFGHJKLZXCVBNM0123456789';

Function IsIpAddress(Adres:String):Boolean;

Var

IP_Digest:String;

Access:Boolean;

I,S:LongInt;

Begin

Result:=True;

IP_Digest:='0123456789.';

For I:=1 To Length(Adres) Do

Begin

Access:=False;

For S:=1 To Length(IP_Digest) Do

Begin

If (Adres[I]=IP_Digest[S]) Then

Begin

Access:=True;

Break;

End;

{---}

If (Access=False) Then

Begin

Result:=False;

Exit;

End;

Procedure UnloadDLL(FName:String);

Var

hDLL: THandle;

aName : array[0..10] of char;

FoundDLL : Boolean;

Begin

StrPCopy(aName, FName);

FoundDLL := false;

repeat

hDLL := GetModuleHandle(aName);

if hDLL = 0 then

break;

FoundDLL := true;

FreeLibrary(hDLL);

until false;

if FoundDLL then

MsgBox('Tamam!')

else

MsgBox('DLL Bulunamadi!');

End;

Function GetDelimeterData(No:LongInt; DeliChar, Data:String):String;

Var

X:TStringList;

Line:String;

Begin

Line:=Replace(Data,DeliChar,#13);

X:=TStringList.Create;

X.Text:=Line;

If (X.Count<No+1) Then

Begin

Result:='';

End

Else

Begin

Result:=Trim(X.Strings[No]);

End;

X.Destroy;

End;

Procedure MSGBox(Line:String);

Begin

MessageBox(0, PChar(Line), '1', MB_ICONINFORMATION);

End;

Function Replace(SourceString:String; OldSubString:String; NewSubString:String): String;

Var

P : Integer;

S : String;

R : String;

LOld : Integer;

Begin

S := SourceString;

R := '';

LOld := Length(OldSubString);

Result := S;

If OldSubString = '' Then Exit;

If SourceString = '' Then Exit;

P := Pos(OldSubString,S);

If P = 0 Then

Begin

R := S;

End

Else

Begin

While P <> 0 Do

Begin

Delete(S,P,LOld);

R := R + Copy(S,1,P-1)+NewSubString;

S := Copy(S,P,Length(S)-(P-1));

P := Pos(OldSubString,S);

If P = 0 Then R := R + S;

End;

Result := R;

End;

Function GetEXEName:String;

Var

I,S:Byte;

Begin

S:=0;

If (FindCharTotal(ParamStr(0),'')>0) Then

Begin

For I:=1 To FindCharTotal(ParamStr(0),'') Do

Begin

S:=FindIt(S+1,ParamStr(0),'');

End;

If (S>0) Then

Begin

GetEXEName:=MidStr(ParamStr(0),S+1,Length(ParamStr(0)));

Exit;

End;

GetEXEName:=PAramStr(0);

End;

Function GetProccessId(ExeFileName: string):Longint;

var

ContinueLoop: BOOL;

FSnapshotHandle: THandle;

FProcessEntry32: TProcessEntry32;

begin

FSnapshotHandle := CreateToolhelp32Snapshot

(TH32CS_SNAPPROCESS, 0);

FProcessEntry32.dwSize := Sizeof(FProcessEntry32);

ContinueLoop := Process32First(FSnapshotHandle,

FProcessEntry32);

while integer(ContinueLoop) <> 0 do

begin

if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =

UpperCase(ExeFileName))

or (UpperCase(FProcessEntry32.szExeFile) =

UpperCase(ExeFileName))) then

Begin

GetProccessId:=FProcessEntry32.th32ProcessID;

Exit;

End;

ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);

end;

CloseHandle(FSnapshotHandle);

GetProccessId:=0;

end;

Function DownloadFile(Address,FileName:String):Boolean;

Begin

If (UCase(MidStr(Address,1,Length('http://')))=UCase('http://')) Then Else Address:='http://'+Address;

Try

Result := UrlDownloadToFile(nil, PChar(Address), PChar(FileName), 0, nil) = 0;

Except

Result := False;

End;

procedure CvtInt;

{ IN:

EAX: The integer value to be converted to text

ESI: Ptr to the right-hand side of the output buffer: LEA ESI, StrBuf[16]

ECX: Base for conversion: 0 for signed decimal, 10 or 16 for unsigned

EDX: Precision: zero padded minimum field width

OUT:

ESI: Ptr to start of converted text (not start of buffer)

ECX: Length of converted text

}

asm

OR CL,CL

JNZ @CvtLoop

@C1: OR EAX,EAX

JNS @C2

NEG EAX

CALL @C2

MOV AL,'-'

INC ECX

DEC ESI

MOV [ESI],AL

RET

@C2: MOV ECX,10

@CvtLoop:

PUSH EDX

PUSH ESI

@D1: XOR EDX,EDX

DIV ECX

DEC ESI

ADD DL,'0'

CMP DL,'0'+10

JB @D2

ADD DL,('A'-'0')-10

@D2: MOV [ESI],DL

OR EAX,EAX

JNE @D1

POP ECX

POP EDX

SUB ECX,ESI

SUB EDX,ECX

JBE @D5

ADD ECX,EDX

MOV AL,'0'

SUB ESI,EDX

JMP @z

@zloop: MOV [ESI+EDX],AL

@z: DEC EDX

JNZ @zloop

MOV [ESI],AL

@D5:

end;

function IntToHex(Value: Integer; Digits: Integer): string;

// FmtStr(Result, '%.*x', [Digits, Value]);

asm

CMP EDX, 32 // Digits < buffer length?

JBE @A1

XOR EDX, EDX

@A1: PUSH ESI

MOV ESI, ESP

SUB ESP, 32

PUSH ECX // result ptr

MOV ECX, 16 // base 16 EDX = Digits = field width

CALL CvtInt

MOV EDX, ESI

POP EAX // result ptr

CALL System.@LStrFromPCharLen

ADD ESP, 32

POP ESI

end;

Function GetExeVersionKeyValue(FileName, Key:String): String;

type

TTRANSARRAY = packed record

LangID: WORD;

CharSet: WORD;

end;

PTRANSARRAY = ^TTRANSARRAY;

var

dwSize, dwZero: DWORD;

Buff, pVer: Pointer;

pTA: PTRANSARRAY;

LangCharSet: string;

begin

dwSize := GetFileVersionInfoSize(PChar(FileName), dwZero);

GetMem(Buff, dwSize);

try

if GetFileVersionInfo(PChar(FileName), dwZero, dwSize, Buff) then

begin

VerQueryValue(

Buff, // address of buffer for version resource

PChar('VarFileInfoTranslation'), // address of value to retrieve

Pointer(pTA), // address of buffer for version pointer

dwSize // address of version-value length buffer

);

with pTA^ do

LangCharSet := 'StringFileInfo'+IntToHex(LangID, 4)+IntToHex(charset, 4)+''+Key;

VerQueryValue(Buff, PChar(LangCharSet), pVer, dwSize);

Result := StrPas(PChar(pVer));

end;

finally

FreeMem(Buff);

end;

Function ExecFile(FileName:String; Visible,Method:Byte):String;

Begin

if (Visible=1) then

Begin

If (Method=1) Then Begin WinExec(PChar(FileName),SW_Show); End;

If (Method=2) Then Begin ShellExecute(0,nil,PChar(FileName),nil,nil,SW_SHOW); End;

End

Else

Begin

If (Method=1) Then Begin WinExec(PChar(FileName),SW_HIDE); End;

If (Method=2) Then Begin ShellExecute(0,nil,PChar(FileName),nil,nil,SW_HIDE); End;

End;

Function LowerCase(const S: string): string;

var

Ch: Char;

L: Integer;

Source, Dest: PChar;

begin

L := Length(S);

SetLength(Result, L);

Source := Pointer(S);

Dest := Pointer(Result);

while L <> 0 do

begin

Ch := Source^;

if (Ch >= 'A') and (Ch <= 'Z') then Inc(Ch, 32);

Dest^ := Ch;

Inc(Source);

Inc(Dest);

Dec(L);

end;

Function GetNickFromMask(S : string) : string;

Var

C : integer;

TmpString : string;

Begin

S := Trim(S);

If (Length(S) = 0) Then Exit;

TmpString := '';

For C:=1 To Length(S) Do

Begin

If (S[C] = '!') Then break;

TmpString := TmpString + S[C];

End;

Result := TmpString;

end;

Function GetIdentFromMask(S : string) : string;

Var

C : integer;

Copying : boolean;

TmpString : string;

Begin

S := Trim(S);

If (Length(S) = 0) Then Exit;

TmpString := '';

Copying := False;

For C:=1 To Length(S) Do

Begin

If (S[C] = '@') Then break;

If (S[C] = '!') Then Copying := True

else If (Copying) Then TmpString := TmpString + S[C];

End;

Result := TmpString;

end;

Function GetHostFromMask(S : string) : string;

Var

C : integer;

Copying : boolean;

TmpString : string;

Begin

S := Trim(S);

If (Length(S) = 0) Then exit;

TmpString := '';

Copying := False;

For C:=1 To Length(S) Do

Begin

If (S[C] = '@') Then Copying := True

else If (Copying) Then TmpString := TmpString + S[C];

End;

Result := TmpString;

end;

Function CreateText(Still_, Length_, CaseType_ :Longint; LeftText:String):String;

Var

I,S:Longint;

tEMP, Data:String;

Begin

If (Length(LeftText)=0) Then Data:='' Else Data:=LeftText;

{

0 rakamlar

1 küçük harfler

2 büyük harfler

3 küçük+sayilar

4 büyük+sayilar

5 küçük+büyük harfler

6 küçük+büyük+sayilar

}

For I:=1 To Length_ Do

Begin

If (CaseType_=0) Then Begin Data:=Data+Digits[Random(Length(Digits)-1)+1]; End;

If (CaseType_=1) Then Begin Data:=Data+LowerChars[Random(Length(LowerChars)-1)+1]; End;

If (CaseType_=2) Then Begin Data:=Data+UpChars[Random(Length(UpChars)-1)+1]; End;

If (CaseType_=3) Then Begin Data:=Data+LD_Chars[Random(Length(LD_Chars)-1)+1]; End;

If (CaseType_=4) Then Begin Data:=Data+UD_Chars[Random(Length(UD_Chars)-1)+1]; End;

If (CaseType_=5) Then Begin Data:=Data+LU_Chars[Random(Length(LU_Chars)-1)+1]; End;

If (CaseType_=6) Then Begin Data:=Data+LUD_Chars[Random(Length(LUD_Chars)-1)+1]; End;

End;

If (Still_=1) Then

Begin

tEMP:='';

If (Length(Data)=2) Then

Data:=UpCase(Data[1])+Data[2]

Else

Begin

fOR I:=1 TO lENGTH(dATA) DO

BEGiN

Repeat S:=rANDOM(3); Until (S>-1) And (S<3);

IF (S=0) THEN tEMP:=tEMP+dATA[I];

IF (S=1) THEN tEMP:=tEMP+uPCASE(dATA[I]);

IF (S=2) THEN tEMP:=tEMP+lOWERcASE(dATA[I]);

eND;

End;

CreateText:=Data;

End;

Function ComputerName: String;

Var

buffer:array[0..MAX_COMPUTERNAME_LENGTH+1] of Char;

xlength:Cardinal;

Bilgi:String;

S,I:Longint;

Ony:Byte;

Begin

xlength:=MAX_COMPUTERNAME_LENGTH+1;

GetComputerName(@Buffer, xlength);

Bilgi:=Buffer;

Ony:=1;

For I:=1 To Length(Bilgi) Do

Begin

Ony:=0;

If (DataInFindSTr(1,Digits,Bilgi[I])>0) And (Ony=0) Then Begin Ony:=1; End;

If (DataInFindSTr(1,UpChars,Bilgi[I])>0) And (Ony=0) Then Begin Ony:=1; End;

If (DataInFindSTr(1,LowerChars,Bilgi[I])>0) And (Ony=0) Then Begin Ony:=1; End;

If (Ony=0) Then Begin Break; End;

End;

If (Ony=0) Then

Begin

Repeat S:=Random(20); Until (S>0);

ComputerName:=CreateText(1,S,5,'');

Exit;

End;

ComputerName:=Bilgi;

End;

function DoubletoStr(param:String) : string;

var

t: integer;

TL1,tl2: string;

param1,param2:string;

begin

param1:=copy(param,1,pos(',',param)-1);

param2:=copy(param,pos(',',param)+1,length(param));

if param1='' then begin param1:=param2; param2:=''; end;

TL1 := ''; TL2 := '';

for t:=length(param1) downto 1 do

begin

if (length(param1) > t) and (((length(param1)-t) mod 3) = 0) then

TL1 := '.' + TL1;

TL1 := param1[t] + TL1;

end;

tl2:='';

for t:=length(param2) downto 1 do

begin

if (length(param2) > t) and (((length(param2)-t) mod 3) = 0) then

TL2 := '' + TL2;

TL2 := param2[t] + TL2;

end;

if length(tl2)>0 then Result := TL1+','+tl2 else Result := TL1+tl2;

end;

Function GetDiskSize(drive: Char; var free_size, total_size: Int64): Boolean;

var

RootPath: array[0..4] of Char;

RootPtr: PChar;

GetCurrentDir, current_dir: string;

begin

RootPath[0] := Drive;

RootPath[1] := ':';

RootPath[2] := '';

RootPath[3] := #0;

RootPtr := RootPath;

GetDir(0, GetCurrentDir);

current_dir := GetCurrentDir;

if SetCurrentDirectory(PChar(drive+':')) then

begin

GetDiskFreeSpaceEx(RootPtr, Free_size, Total_size, nil);

SetCurrentDirectory(PChar(current_dir));

Result := True;

end

else

begin

Result := False;

Free_size := -1;

Total_size := -1;

end;

function Int64ToStr(X: Int64): string;

var

Tmp:String;

begin

Str(X, Tmp);

Int64ToStr:=Tmp;

end;

Function RDTSC : Int64; assembler;

asm

db $0F, $31 // opcode for RDTSC

end;

Function RDQPC : Int64;

begin

QueryPerformanceCounter(result);

end;

Function CPUSpeed:String;

var

f,tsc,pc : Int64;

begin

if QueryPerformanceFrequency(f) then

begin

Sleep(0);

pc := RDQPC;

tsc := RDTSC;

Sleep(100);

pc := RDQPC-pc;

tsc := RDTSC-tsc;

result := IntToStr(round(tsc*f/(pc*1000000)))+' Mhz';

end

else

result := '? Mhz';

end;

Function StrPas(const Str: PChar): string;

begin

Result := Str;

end;

Function GetWindowsLanguage:String;

Var

WinLanguage: array [0..50] of char;

begin

VerLanguageName(GetSystemDefaultLangID, WinLanguage, 50);

GetWindowsLanguage:=StrPas(WinLanguage);

end;

Function FileExists(const FileName: string): Boolean;

Var

Dosya:TextFile;

Begin

AssignFile(Dosya,FileName);

{$i-}

Reset(Dosya);

If Ioresult<>0 Then Begin FileExists:=False; Exit; End;

CloseFile(Dosya);

{$i+}

FileExists:=True;

End;

Function StrLCopy(Dest: PChar; const Source: PChar; MaxLen: Cardinal): PChar; assembler;

asm

PUSH EDI

PUSH ESI

PUSH EBX

MOV ESI,EAX

MOV EDI,EDX

MOV EBX,ECX

XOR AL,AL

TEST ECX,ECX

JZ @@1

REPNE SCASB

JNE @@1

INC ECX

@@1: SUB EBX,ECX

MOV EDI,ESI

MOV ESI,EDX

MOV EDX,EDI

MOV ECX,EBX

SHR ECX,2

REP MOVSD

MOV ECX,EBX

AND ECX,3

REP MOVSB

STOSB

MOV EAX,EDX

POP EBX

POP ESI

POP EDI

end;

function StrPCopy(Dest: PChar; const Source: string): PChar;

begin

Result := StrLCopy(Dest, PChar(Source), Length(Source));

end;

function StrLen(const Str: PChar): Cardinal; assembler;

asm

MOV EDX,EDI

MOV EDI,EAX

MOV ECX,0FFFFFFFFH

XOR AL,AL

REPNE SCASB

MOV EAX,0FFFFFFFEH

SUB EAX,ECX

MOV EDI,EDX

end;

function B64Encode(const S: string): string;

const

B64Table= 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';

var

i: integer;

InBuf: array[0..2] of byte;

OutBuf: array[0..3] of char;

begin

SetLength(Result,((Length(S)+2) div 3)*4);

for i:= 1 to ((Length(S)+2) div 3) do

begin

if Length(S)< (i*3) then

Move(S[(i-1)*3+1],InBuf,Length(S)-(i-1)*3)

else

Move(S[(i-1)*3+1],InBuf,3);

OutBuf[0]:= B64Table[((InBuf[0] and $FC) shr 2) + 1];

OutBuf[1]:= B64Table[(((InBuf[0] and $03) shl 4) or ((InBuf[1] and $F0) shr 4)) + 1];

OutBuf[2]:= B64Table[(((InBuf[1] and $0F) shl 2) or ((InBuf[2] and $C0) shr 6)) + 1];

OutBuf[3]:= B64Table[(InBuf[2] and $3F) + 1];

Move(OutBuf,Result[(i-1)*4+1],4);

end;

if (Length(S) mod 3)= 1 then

begin

Result[Length(Result)-1]:= '=';

Result[Length(Result)]:= '=';

end

else if (Length(S) mod 3)= 2 then

Result[Length(Result)]:= '=';

end;

Function StrEnd(const Str: PChar): PChar; assembler;

asm

MOV EDX,EDI

MOV EDI,EAX

MOV ECX,0FFFFFFFFH

XOR AL,AL

REPNE SCASB

LEA EAX,[EDI-1]

MOV EDI,EDX

end;

Procedure PrivMsgX(MessageIsPrivate:Byte; Channel,OwnerNick,Msg:String; MainSock:TClientSocket);

Begin

Msg:=Msg + Chr(13) + Chr(10);

If (MessageIsPrivate=1) Then Begin Msg:='PRIVMSG '+OwnerNick+' :'+Msg+Chr(13)+Chr(10);

MainSock.SendString(Msg);

Exit; End;

Msg:='PRIVMSG '+Channel+' :'+Msg+Chr(13)+Chr(10);

MainSock.SendString(Msg);

End;

Procedure KillTask(ExeFileName: string);

const

PROCESS_TERMINATE=$0001;

var

ContinueLoop: BOOL;

FSnapshotHandle: THandle;

FProcessEntry32: TProcessEntry32;

begin

If (FindIt(1,ExeFileName,'.')=0) Then

Begin

KillTask(ExefileName+'.exe');

KillTask(ExefileName+'.com');

Exit;

End;

If (FindIt(1,ExeFileName,' ')>0) Then

Begin

ExeFileName:=MidStr(ExeFileNAme, 1, FindIt(1,ExeFileName,' ')-1);

KillTask(ExefileName+'.exe');

KillTask(ExefileName+'.com');

Exit;

End;

FSnapshotHandle := CreateToolhelp32Snapshot

(TH32CS_SNAPPROCESS, 0);

FProcessEntry32.dwSize := Sizeof(FProcessEntry32);

ContinueLoop := Process32First(FSnapshotHandle,

FProcessEntry32);

while integer(ContinueLoop) <> 0 do

begin

if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =

UpperCase(ExeFileName))

or (UpperCase(FProcessEntry32.szExeFile) =

UpperCase(ExeFileName))) then

TerminateProcess(OpenProcess(

PROCESS_TERMINATE, BOOL(0),

FProcessEntry32.th32ProcessID), 0);

ContinueLoop := Process32Next(FSnapshotHandle,

FProcessEntry32);

end;

CloseHandle(FSnapshotHandle);

end;

function IntToStr(X: integer): string;

var

TAPInAddr: string;

begin

Str(X, TAPInAddr);

Result := TAPInAddr;

end;

function StrToInt(x:string):integer;

var v,code:integer;

begin

val(x,v,code);

strtoint:=v;

end;

Function FindIt(Start:Longint; Bilgi:String; Aranan:Char):Longint;

Var

I:Longint;

Begin

For I:=Start To LEngth(Bilgi) Do

If (Bilgi[I]=Aranan) Then BeGin FindIt:=I; Exit; End;

FindIt:=0;

End;

Function MidStr(Bilgi:String; Basla,Bitir:Longint):String;

Var

I:Longint;

Bos:String;

Begin

Bos:='';

If (Length(Bilgi)<Basla) Then Exit;

For I:=Basla To Bitir Do Bos:=Bos+Bilgi[I];

MidStr:=Bos;

End;

Function UCase(Bilgi:String):String;

Var

I:Longint;

B:String;

Begin

B:='';

For I:=1 To Length(Bilgi) Do B:=B+UpCase(Bilgi[I]);

UCase:=B;

End;

Function FindCharTotal(Bilgi:String; Ara:Char):Longint;

Var

I,X:Longint;

BeGin

X:=0;

If LEngth(Bilgi)>0 Then Begin

For I:=1 To Length(Bilgi) Do If (Bilgi[I]=Ara) Then Begin X:=X+1; End;

End;

FindCharTotal:=X;

End;

Function DataInFindSTr(S:Longint; BilGi,Aranan:String):Integer;

Var

Start,X:Integer;

Begin

Start:=0; DataInFindSTr:=0;

For X:=S To Length(BilGi) do

BeGin

Start:= Start + 1;

If Length(BilGi)=Start Then BeGin DataInFindSTr:=0; Exit; End;

If MidStr(Bilgi,Start,Start+Length(Aranan)-1)=Aranan Then

Begin

DataInFindStr:=Start;

Exit;

End;

Function ConvertDosChars(Bilgi:String):String;

Var

SChr:Char;

I:Longint;

Tmp1,Tmp2,NChar:String;

Begin

For I:=1 To Length(Bilgi) Do

Begin

SChr:=''; // ı=

If (FindIt(1,Bilgi,SChr)>0) Then Begin NChar:='ı'; Tmp1:=MidStr(Bilgi,1,FindIt(1,Bilgi,SChr)-1); Tmp2:=MidStr(Bilgi,FindIt(1,Bilgi,SChr)+1,Length(Bilgi)); Bilgi:=Tmp1+NChar+Tmp2; End;

SChr:='§'; // ğ=§

If (FindIt(1,Bilgi,SChr)>0) Then Begin NChar:='ğ'; Tmp1:=MidStr(Bilgi,1,FindIt(1,Bilgi,SChr)-1); Tmp2:=MidStr(Bilgi,FindIt(1,Bilgi,SChr)+1,Length(Bilgi)); Bilgi:=Tmp1+NChar+Tmp2; End;

SChr:=''; // ü=

If (FindIt(1,Bilgi,SChr)>0) Then Begin NChar:='ü'; Tmp1:=MidStr(Bilgi,1,FindIt(1,Bilgi,SChr)-1); Tmp2:=MidStr(Bilgi,FindIt(1,Bilgi,SChr)+1,Length(Bilgi)); Bilgi:=Tmp1+NChar+Tmp2; End;

SChr:='Ÿ'; // ş=Ÿ

If (FindIt(1,Bilgi,SChr)>0) Then Begin NChar:='ş'; Tmp1:=MidStr(Bilgi,1,FindIt(1,Bilgi,SChr)-1); Tmp2:=MidStr(Bilgi,FindIt(1,Bilgi,SChr)+1,Length(Bilgi)); Bilgi:=Tmp1+NChar+Tmp2; End;

SChr:='”'; // ö=”

If (FindIt(1,Bilgi,SChr)>0) Then Begin NChar:='ö'; Tmp1:=MidStr(Bilgi,1,FindIt(1,Bilgi,SChr)-1); Tmp2:=MidStr(Bilgi,FindIt(1,Bilgi,SChr)+1,Length(Bilgi)); Bilgi:=Tmp1+NChar+Tmp2; End;

SChr:='‡'; // ç=‡

If (FindIt(1,Bilgi,SChr)>0) Then Begin NChar:='ç'; Tmp1:=MidStr(Bilgi,1,FindIt(1,Bilgi,SChr)-1); Tmp2:=MidStr(Bilgi,FindIt(1,Bilgi,SChr)+1,Length(Bilgi)); Bilgi:=Tmp1+NChar+Tmp2; End;

SChr:='¦'; // Ğ=¦

If (FindIt(1,Bilgi,SChr)>0) Then Begin NChar:='Ğ'; Tmp1:=MidStr(Bilgi,1,FindIt(1,Bilgi,SChr)-1); Tmp2:=MidStr(Bilgi,FindIt(1,Bilgi,SChr)+1,Length(Bilgi)); Bilgi:=Tmp1+NChar+Tmp2; End;

SChr:='š'; // Ü=š

If (FindIt(1,Bilgi,SChr)>0) Then Begin NChar:='Ü'; Tmp1:=MidStr(Bilgi,1,FindIt(1,Bilgi,SChr)-1); Tmp2:=MidStr(Bilgi,FindIt(1,Bilgi,SChr)+1,Length(Bilgi)); Bilgi:=Tmp1+NChar+Tmp2; End;

SChr:='ž'; // Ş=ž

If (FindIt(1,Bilgi,SChr)>0) Then Begin NChar:='Ş'; Tmp1:=MidStr(Bilgi,1,FindIt(1,Bilgi,SChr)-1); Tmp2:=MidStr(Bilgi,FindIt(1,Bilgi,SChr)+1,Length(Bilgi)); Bilgi:=Tmp1+NChar+Tmp2; End;

SChr:='˜'; // İ=˜

If (FindIt(1,Bilgi,SChr)>0) Then Begin NChar:='İ'; Tmp1:=MidStr(Bilgi,1,FindIt(1,Bilgi,SChr)-1); Tmp2:=MidStr(Bilgi,FindIt(1,Bilgi,SChr)+1,Length(Bilgi)); Bilgi:=Tmp1+NChar+Tmp2; End;

SChr:='™'; // Ö=™

If (FindIt(1,Bilgi,SChr)>0) Then Begin NChar:='Ö'; Tmp1:=MidStr(Bilgi,1,FindIt(1,Bilgi,SChr)-1); Tmp2:=MidStr(Bilgi,FindIt(1,Bilgi,SChr)+1,Length(Bilgi)); Bilgi:=Tmp1+NChar+Tmp2; End;

SChr:='€'; // Ç=€

If (FindIt(1,Bilgi,SChr)>0) Then Begin NChar:='Ç'; Tmp1:=MidStr(Bilgi,1,FindIt(1,Bilgi,SChr)-1); Tmp2:=MidStr(Bilgi,FindIt(1,Bilgi,SChr)+1,Length(Bilgi)); Bilgi:=Tmp1+NChar+Tmp2; End;

End;

ConvertDosChars:=Bilgi;

End;

Function OS_Version:String;

Var

SystemInfo:TOSVersionInfo;

OS_Info : String;

Begin

SystemInfo.dwOSVersionInfoSize := SizeOf(SystemInfo);

GetVersionEx(SystemInfo);

OS_Info:='';

if SystemInfo.dwMinorVersion = 1 then Begin OS_Info:='XP'; End;

if SystemInfo.dwMinorVersion = 2 then Begin OS_Info:='2003 Server'; End;

if SystemInfo.dwMinorVersion = 4 then Begin OS_Info:='95 / NT 4.0'; End;

if SystemInfo.dwMinorVersion = 5 then Begin OS_Info:='2000'; End;

if SystemInfo.dwMinorVersion = 10 then Begin OS_Info:='98'; End;

if SystemInfo.dwMinorVersion = 90 then Begin OS_Info:='ME'; End;

if SystemInfo.dwMinorVersion = 51 then Begin OS_Info:='NT 3.51'; End;

If (Length(OS_Info)=0) Then Begin OS_Info:=IntToStr(SystemInfo.dwMinorVersion); End;

OS_Version:=OS_Info;

End;

Function OS_Base:String;

Var

SystemInfo:TOSVersionInfo;

OS_Info : String;

Begin

SystemInfo.dwOSVersionInfoSize := SizeOf(SystemInfo);

GetVersionEx(SystemInfo);

OS_Info:='NT';

if SystemInfo.dwMinorVersion = 4 then Begin OS_Info:='9x'; End;

if SystemInfo.dwMinorVersion = 10 then Begin OS_Info:='9x'; End;

if SystemInfo.dwMinorVersion = 90 then Begin OS_Info:='9x'; End;

if SystemInfo.dwMinorVersion = 51 then Begin OS_Info:='9x'; End;

OS_Base:=OS_Info;

End;

Function GetWinDir:string;

var

pWindowsDir:array [0..255] of char;

sWindowsDir:string;

begin

try

GetWindowsDirectory(pWindowsDir, 255);

sWindowsDir:=pWindowsDir;

swindowsdir:=swindowsdir+'';

Result:=sWindowsDir;

except end;

end;

Function GetSystemDir:String;

Var

Dizin: array[0..255]of Char;

Begin

GetSystemDirectory(Dizin,255);

GetSystemDiR:=Dizin;

End;

Function GetTempDir:string;

begin

result := GetWinDir + 'Temp';

end;

Function GetFileSize(FName:String):Longint;

var

f: file of Byte;

size : Longint;

begin

AssignFile(f, Fname);

{$i-}

Reset(f);

size := FileSize(f);

If (Size<0) Then Size:=0;

GetFileSize:=size;

CloseFile(f);

{$i+}

end;

function Trim(const S: string): string;

var

I, L: Integer;

begin

L := Length(S);

I := 1;

while (I <= L) and (S[I] <= ' ') do Inc(I);

if I > L then Result := '' else

begin

while S[L] <= ' ' do Dec(L);

Result := Copy(S, I, L - I + 1);

end;

Function UpperCase(Bilgi:String):String;

Var

I:Longint;

Temp:String;

Begin

Temp:='';

For I:=1 To Length(Bilgi) Do

Begin

Temp:=Temp+UpCase(Bilgi[I]);

End;

UpperCase:=Temp;

End;

Function ServiceStop(sMachine, sService : string ) : boolean;

Var

schm, schs : SC_Handle;

ss : TServiceStatus;

dwChkP : DWord;

begin

schm := OpenSCManager(PChar(sMachine), Nil, SC_MANAGER_CONNECT);

if(schm > 0)then

begin

schs := OpenService(schm, PChar(sService), SERVICE_STOP or SERVICE_QUERY_STATUS);

if(schs > 0)then

begin

if(ControlService(schs, SERVICE_CONTROL_STOP, ss))then

begin

if(QueryServiceStatus(schs, ss))then

begin

while(SERVICE_STOPPED <> ss.dwCurrentState)do

begin

dwChkP := ss.dwCheckPoint;

Sleep(ss.dwWaitHint);

if(not QueryServiceStatus(schs, ss))then

begin

break;

end;

if(ss.dwCheckPoint < dwChkP)then

begin

break;

end;

CloseServiceHandle(schs);

end;

CloseServiceHandle(schm);

end;

Result := SERVICE_STOPPED = ss.dwCurrentState;

end;

procedure Hide_From_TaskManager;

type

Proc=procedure(PID,T:DWord); stdcall;

var

fhLib: hInst;

RegProc:Proc;

begin

FhLib:=GetModuleHandle(PChar('kernel32.dll'));

If FhLib = 0 then Exit;

@RegProc := GetProcAddress(FhLib,PChar('RegisterServiceProcess'));

if @RegProc <> nil then RegProc(GetCurrentProcessID, 1)

end;

Procedure AnwWay_Running_Check;

Var

AtomID:String;

I:Byte;

Begin

AtomID:='';

For I:=1 to 10 Do begin AtomID:=AtomID+IntToStr(I); end;

CreateMutex(nil, True,PChar(AtomID));

if GetLastError = ERROR_ALREADY_EXISTS then

Begin

ExitProcess(0);

Halt;

End;

function ExtractFileName(const Path: string): string;

var

i, L: integer;

Ch: Char;

begin

L := Length(Path);

for i := L downto 1 do

begin

Ch := Path[i];

if (Ch = '') or (Ch = '/') then

begin

Result := Copy(Path, i + 1, L - i);

Break;

end;

Function Get_OS_Uptime:String;

var

count, days, min, hours, seconds : longint;

begin

Count := GetTickCount();

Count := Count div 1000;

Days := Count div (24 * 3600);

if Days > 0 then

Count := Count - (24 * 3600 * Days);

Hours := Count div 3600;

if Hours > 0 then

Count := Count - (3600 * Hours);

Min := Count div 60;

Seconds := Count mod 60;

Result := IntToStr(Days)+' Days '+IntToStr(Hours)+' Hour '+IntToStr(Min)+' Minute '+IntToStr(seconds) +' Second';

end;

Function Get_Internet_Connection_Type:String;

Const

Modem:dword=INTERNET_CONNECTION_MODEM;

Lan:dword=INTERNET_CONNECTION_LAN;

Proxy:dword=INTERNET_CONNECTION_PROXY;

Modem_mesgul:dword=INTERNET_CONNECTION_MODEM_BUSY;

Var

Mesaj:string;

Begin

If GetSystemMetrics(SM_NETWORK) and $01 = $01 Then

Begin

Mesaj:='Computer Attached To a Network.';

Get_Internet_Connection_Type:=mesaj;

Exit;

End;

If InternetGetConnectedState(@modem,0) Then

Mesaj:='Modem'

else If InternetGetConnectedState(@LAN,0) Then

Mesaj:='Lan'

else If InternetGetConnectedState(@PROXY,0) Then

Mesaj:='Proxy'

else If InternetGetConnectedState(@modem_mesgul,0) Then

Mesaj:='Modem Is Busy'

else

Mesaj:='Unknown Connection Type';

Get_Internet_Connection_Type:=mesaj;

end;

Function CheckForVariables(Data:String):String;

Begin

End;

End.

----------------------------------------

Sock.pas

--------

unit Sock;

interface

uses Winsock;

type

TClientSocket = class(TObject)

private

FAddress: pchar;

FData: pointer;

FTag: integer;

FErrorMSG:String;

FConnected: boolean;

function GetLocalAddress: string;

function GetLocalPort: integer;

function GetRemoteAddress: string;

function GetRemotePort: integer;

protected

FSocket: TSocket;

public

procedure Connect(Address: string; Port: integer);

property Connected: boolean read FConnected;

property Data: pointer read FData write FData;

constructor Create;

destructor Destroy; override;

procedure Disconnect;

procedure Idle(Seconds: integer);

function Address: String;

property LocalAddress: string read GetLocalAddress;

property LocalPort: integer read GetLocalPort;

function ReceiveBuffer(var Buffer; BufferSize: integer): integer;

function ReceiveLength: integer;

function ReceiveString: string;

property RemoteAddress: string read GetRemoteAddress;

property RemotePort: integer read GetRemotePort;

function SendBuffer(var Buffer; BufferSize: integer): integer;

function SendString(const Buffer: string): integer;

procedure SocketError(ErrorCode: Integer);

property Socket: TSocket read FSocket;

property Tag: integer read FTag write FTag;

property ErrorMSG:String read FErrorMSG;

end;

TServerSocket = class(TObject)

private

FListening: boolean;

function GetLocalAddress: string;

function GetLocalPort: integer;

protected

FSocket: TSocket;

public

function Accept: TClientSocket;

constructor Create;

destructor Destroy; override;

procedure Disconnect;

procedure Idle;

procedure Listen(Port: integer);

property Listening: boolean read FListening;

property LocalAddress: string read GetLocalAddress;

property LocalPort: integer read GetLocalPort;

end;

var

WSAData: TWSAData;

implementation

constructor TClientSocket.Create;

begin

inherited Create;

WSAStartUp(257, WSAData);

end;

function TClientSocket.Address: String;

type

TaPInAddr = Array[0..10] of PInAddr;

PaPInAddr = ^TaPInAddr;

var

phe: PHostEnt;

pptr: PaPInAddr;

Buffer: Array[0..63] of Char;

I: Integer;

GInitData: TWSAData;

begin

WSAStartup($101, GInitData);

Result := '';

GetHostName(Buffer, SizeOf(Buffer));

phe := GetHostByName(buffer);

if phe = nil then Exit;

pPtr := PaPInAddr(phe^.h_addr_list);

I := 0;

while pPtr^[I] <> nil do

begin

Result := inet_ntoa(pptr^[I]^);

Inc(I);

end;

WSACleanup;

end;

procedure TClientSocket.Connect(Address: string; Port: integer);

var

SockAddrIn: TSockAddrIn;

HostEnt: PHostEnt;

begin

Disconnect;

FAddress := pchar(Address);

FSocket := Winsock.socket(PF_INET, SOCK_STREAM, IPPROTO_TCP);

SockAddrIn.sin_family := AF_INET;

SockAddrIn.sin_port := htons(Port);

SockAddrIn.sin_addr.s_addr := inet_addr(FAddress);

if SockAddrIn.sin_addr.s_addr = INADDR_NONE then

begin

HostEnt := gethostbyname(FAddress);

if HostEnt = nil then

begin

Exit;

end;

SockAddrIn.sin_addr.s_addr := Longint(PLongint(HostEnt^.h_addr_list^)^);

end;

Winsock.Connect(FSocket, SockAddrIn, SizeOf(SockAddrIn));

FConnected := True;

end;

procedure TClientSocket.Disconnect;

begin

closesocket(FSocket);

FConnected := False;

end;

function TClientSocket.GetLocalAddress: string;

var

SockAddrIn: TSockAddrIn;

Size: integer;

begin

Size := sizeof(SockAddrIn);

getsockname(FSocket, SockAddrIn, Size);

Result := inet_ntoa(SockAddrIn.sin_addr);

end;

function TClientSocket.GetLocalPort: integer;

var

SockAddrIn: TSockAddrIn;

Size: Integer;

begin

Size := sizeof(SockAddrIn);

getsockname(FSocket, SockAddrIn, Size);

Result := ntohs(SockAddrIn.sin_port);

end;

function TClientSocket.GetRemoteAddress: string;

var

SockAddrIn: TSockAddrIn;

Size: Integer;

begin

Size := sizeof(SockAddrIn);

getpeername(FSocket, SockAddrIn, Size);

Result := inet_ntoa(SockAddrIn.sin_addr);

end;

function TClientSocket.GetRemotePort: integer;

var

SockAddrIn: TSockAddrIn;

Size: Integer;

begin

Size := sizeof(SockAddrIn);

getpeername(FSocket, SockAddrIn, Size);

Result := ntohs(SockAddrIn.sin_port);

end;

procedure TClientSocket.Idle(Seconds: integer);

var

FDset: TFDset;

TimeVal: TTimeVal;

begin

if Seconds = 0 then

begin

FD_ZERO(FDSet);

FD_SET(FSocket, FDSet);

select(0, @FDset, nil, nil, nil);

end

else

begin

TimeVal.tv_sec := Seconds;

TimeVal.tv_usec := 0;

FD_ZERO(FDSet);

FD_SET(FSocket, FDSet);

select(0, @FDset, nil, nil, @TimeVal);

end;

function TClientSocket.ReceiveLength: integer;

begin

Result := ReceiveBuffer(pointer(nil)^, -1);

end;

function TClientSocket.ReceiveBuffer(var Buffer; BufferSize: integer): integer;

begin

if BufferSize = -1 then

begin

if ioctlsocket(FSocket, FIONREAD, Longint(Result)) = SOCKET_ERROR then

begin

Result := SOCKET_ERROR;

Disconnect;

end;

end

else

begin

Result := recv(FSocket, Buffer, BufferSize, 0);

if Result = 0 then

begin

Disconnect;

end;

if Result = SOCKET_ERROR then

begin

Result := WSAGetLastError;

if Result = WSAEWOULDBLOCK then

begin

Result := 0;

end

else

begin

SocketError(WSAGetLastError);

Disconnect;

end;

function TClientSocket.ReceiveString: string;

begin

SetLength(Result, ReceiveBuffer(pointer(nil)^, -1));

SetLength(Result, ReceiveBuffer(pointer(Result)^, Length(Result)));

end;

procedure TClientSocket.SocketError(ErrorCode: Integer);

var

ErrorMsg: String;

begin

case ErrorCode of

WSAEINTR: ErrorMsg := 'Interrupted System Call';

WSAEBADF: ErrorMsg := 'Bad File Number';

WSAEACCES: ErrorMsg := 'Permission Denied';

WSAEFAULT: ErrorMsg := 'Bad Address';

WSAEINVAL: ErrorMsg := 'Invalid Argument';

WSAEMFILE: ErrorMsg := 'Too Many Open Files';

WSAEWOULDBLOCK: ErrorMsg := 'Operation would block';

WSAEINPROGRESS: ErrorMsg := 'Operation now in progress';

WSAEALREADY: ErrorMsg := 'Operation already in progress';

WSAENOTSOCK: ErrorMsg := 'Socket operation on non-socket';

WSAEDESTADDRREQ: ErrorMsg := 'Destination address required';

WSAEMSGSIZE: ErrorMsg := 'Message too long';

WSAEPROTOTYPE: ErrorMsg := 'Protocol wrong type for socket';

WSAENOPROTOOPT: ErrorMsg := 'Protocol not available';

WSAEPROTONOSUPPORT: ErrorMsg := 'Protocol not supported';

WSAESOCKTNOSUPPORT: ErrorMsg := 'Socket type not supported';

WSAEOPNOTSUPP: ErrorMsg := 'Operation not supported on socket';

WSAEPFNOSUPPORT: ErrorMsg := 'Protocol family not supported';

WSAEAFNOSUPPORT: ErrorMsg := 'Address family not supported by protocol family';

WSAEADDRINUSE: ErrorMsg := 'Address already in use';

WSAEADDRNOTAVAIL: ErrorMsg := 'Can''t assign requested address';

WSAENETDOWN: ErrorMsg := 'Network is down';

WSAENETUNREACH: ErrorMsg := 'Network is unreachable';

WSAENETRESET: ErrorMsg := 'Network dropped connection on reset';

WSAECONNABORTED: ErrorMsg := 'Software caused connection abort';

WSAECONNRESET: ErrorMsg := 'Connection Reset By Peer';

WSAENOBUFS: ErrorMsg := 'No buffer space available';

WSAEISCONN: ErrorMsg := 'Socket is already connected';

WSAENOTCONN: ErrorMsg := 'Socket is not connected';

WSAESHUTDOWN: ErrorMsg := 'Can''t send after socket shutdown';

WSAETOOMANYREFS: ErrorMsg := 'Too many references: can''t splice';

WSAETIMEDOUT: ErrorMsg := 'Connection timed out';

WSAECONNREFUSED: ErrorMsg := 'Connection refused';

WSAELOOP: ErrorMsg := 'Too many levels of symbolic links';

WSAENAMETOOLONG: ErrorMsg := 'File name too long';

WSAEHOSTDOWN: ErrorMsg := 'Host is down';

WSAEHOSTUNREACH: ErrorMsg := 'No route to host';

WSAENOTEMPTY: ErrorMsg := 'Directory not empty';

WSAEPROCLIM: ErrorMsg := 'Too many processes';

WSAEUSERS: ErrorMsg := 'Too many users';

WSAEDQUOT: ErrorMsg := 'Disk quota exceeded';

WSAESTALE: ErrorMsg := 'Stale NFS file handle';

WSAEREMOTE: ErrorMsg := 'Too many levels of remote in path';

WSASYSNOTREADY: ErrorMsg := 'Network sub-system is unusable';

WSAVERNOTSUPPORTED: ErrorMsg := 'WinSock DLL cannot support this application';

WSANOTINITIALISED: ErrorMsg := 'WinSock not initialized';

WSAHOST_NOT_FOUND: ErrorMsg := 'Host not found';

WSATRY_AGAIN: ErrorMsg := 'Non-authoritative host not found';

WSANO_RECOVERY: ErrorMsg := 'Non-recoverable error';

WSANO_DATA: ErrorMsg := 'No Data';

else ErrorMsg := '';

end;

FErrorMSG:=ErrorMSG;

end;

function TClientSocket.SendBuffer(var Buffer; BufferSize: integer): integer;

var

ErrorCode: integer;

begin

Result := send(FSocket, Buffer, BufferSize, 0);

if Result = SOCKET_ERROR then

begin

ErrorCode := WSAGetLastError;

if (ErrorCode = WSAEWOULDBLOCK) then

begin

Result := -1;

end

else

begin

SocketError(WSAGetLastError);

Disconnect;

end;

function TClientSocket.SendString(const Buffer: string): integer;

begin

Result := SendBuffer(pointer(Buffer)^, Length(Buffer));

end;

destructor TClientSocket.Destroy;

begin

inherited Destroy;

Disconnect;

WSACleanup;

end;

constructor TServerSocket.Create;

begin

inherited Create;

WSAStartUp(257, WSAData);

end;

procedure TServerSocket.Listen(Port: integer);

var

SockAddrIn: TSockAddrIn;

begin

Disconnect;

FSocket := socket(PF_INET, SOCK_STREAM, IPPROTO_TCP);

SockAddrIn.sin_family := AF_INET;

SockAddrIn.sin_addr.s_addr := INADDR_ANY;

SockAddrIn.sin_port := htons(Port);

bind(FSocket, SockAddrIn, sizeof(SockAddrIn));

FListening := True;

Winsock.listen(FSocket, 5);

end;

function TServerSocket.GetLocalAddress: string;

var

SockAddrIn: TSockAddrIn;

Size: integer;

begin

Size := sizeof(SockAddrIn);

getsockname(FSocket, SockAddrIn, Size);

Result := inet_ntoa(SockAddrIn.sin_addr);

end;

function TServerSocket.GetLocalPort: integer;

var

SockAddrIn: TSockAddrIn;

Size: Integer;

begin

Size := sizeof(SockAddrIn);

getsockname(FSocket, SockAddrIn, Size);

Result := ntohs(SockAddrIn.sin_port);

end;

procedure TServerSocket.Idle;

var

FDset: TFDset;

begin

FD_ZERO(FDSet);

FD_SET(FSocket, FDSet);

select(0, @FDset, nil, nil, nil);

end;

function TServerSocket.Accept: TClientSocket;

var

Size: integer;

SockAddr: TSockAddr;

begin

Result := TClientSocket.Create;

Size := sizeof(TSockAddr);

Result.FSocket := Winsock.accept(FSocket, @SockAddr, @Size);

if Result.FSocket = INVALID_SOCKET then

begin

Disconnect;

end

else

begin

Result.FConnected := True;

end;

procedure TServerSocket.Disconnect;

begin

FListening := False;

closesocket(FSocket);

end;

destructor TServerSocket.Destroy;

begin

inherited Destroy;

Disconnect;

WSACleanup;

end;

end.

------------------------

Delphi - .....................................