Programlama yapalım ve Öğrenelim.

Kullanıcı şifresini değiştirmek

// Windows kullanıcı şifrenizi değiştirmek için aşağıdaki fonksiyonu kullanabilirsiniz.

// Örnek olması açısından forma 1 adet Button koyun ve Click olayına aşağıdaki komutu girin.

unit Unit1;

interface

uses

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

Dialogs;

type

TForm1 = class(TForm)

Button1: TButton;

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

function NetUserChangePassword(Domain: PWideChar; UserName: PWideChar; OldPassword: PWideChar;

NewPassword: PWideChar): Longint; stdcall; external 'netapi32.dll' Name 'NetUserChangePassword';

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

begin

NetUserChangePassword(PWideChar(WideString('HAMURCU')), // Bilgisayar adınız

PWideChar(WideString('Hakan')), // Kullanıcı adınız

PWideChar(WideString('1234')), // Mevcut/eski şifreniz

PWideChar(WideString('5678'))); // Yeni şifreniz

end;

end.

// Kolay gelsin.

// Hakan HAMURCU

// hakan@hamurcu.com

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

Şu anda sistemde ADMIN miyiz?

// Şu anda sistemde ADMIN olup olmadığınızı öğrenmek istiyorsanız aşağıdaki kodu kullanabilirsiniz.

// Formunuza 1 adet Button bırakın ve Click olayını aşağıdaki gibi oluşturun

// Butona bastığınızda şu anda admin olup olmadığınızı öğrenebilirsiniz.

unit unit1;

interface

uses

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

Dialogs, StdCtrls;

type

TForm1 = class(TForm)

Button1: TButton;

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

const

SECURITY_NT_AUTHORITY: TSIDIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 5));

SECURITY_BUILTIN_DOMAIN_RID = $00000020;

DOMAIN_ALIAS_RID_ADMINS = $00000220;

implementation

{$R *.dfm}

function IsAdmin: Boolean;

var

hAccessToken : THandle;

ptgGroups : PTokenGroups;

dwInfoBufferSize : DWORD;

psidAdministrators : PSID;

x : Integer;

bSuccess : BOOL;

begin

Result := False;

bSuccess := OpenThreadToken(GetCurrentThread,TOKEN_QUERY,True,hAccessToken);

if not bSuccess then

begin

if GetLastError=ERROR_NO_TOKEN then bSuccess:=OpenProcessToken(GetCurrentProcess,TOKEN_QUERY,hAccessToken);

end;

if bSuccess then

begin

GetMem(ptgGroups, 1024);

bSuccess := GetTokenInformation(hAccessToken,TokenGroups,ptgGroups,1024,dwInfoBufferSize);

CloseHandle(hAccessToken);

if bSuccess then

begin

AllocateAndInitializeSid(SECURITY_NT_AUTHORITY,2,SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS,0,0,0,0,0,0,psidAdministrators);

{$R-}

for x := 0 to ptgGroups.GroupCount-1 do

Begin

if EqualSid(psidAdministrators,ptgGroups.Groups[x].Sid) then

begin

Result:=True;

Break;

end;

End;

{$R+}

FreeSid(psidAdministrators);

End;

FreeMem(ptgGroups);

end;

End;

procedure TForm1.Button1Click(Sender: TObject);

begin

If IsAdmin Then ShowMessage('Evet Adminsiniz')

Else ShowMessage('Hayır Admin değilsiniz');

end;

end.

// Kolay gelin.

// Hakan HAMURCU

// hakan@hamurcu.com

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

Çalışan uygulama ve/veya Processler hangi kullanıcıya ait?

// Sistemde aktif olarak çalışmakta olan uygulamalar ve processleri hangi kullanıcılar ve hangi domainler altından çalıştırmışlar?

// öğrenmek istiyorsanız aşağıdaki kodları kullanabilirsiniz. Bunun için formunuza 1 adet Button ve 1 adet ListBox yerleştirin

// sonrasında Button'un Click özelliğine aşağıdaki kodları girin.

unit Unit1;

interface

uses

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

Dialogs, StdCtrls, TlHelp32;

type

TForm1 = class(TForm)

Button1: TButton;

ListBox1: TListBox;

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

Type

PTOKEN_USER = ^TOKEN_USER;

RTOKEN_USER = record

User : TSidAndAttributes;

end;

TOKEN_USER = RTOKEN_USER;

var

Form1: TForm1;

implementation

{$R *.dfm}

function GetUserAndDomainFromPID(ProcessId: DWORD; var User, Domain: string): Boolean;

var

hToken : THandle;

cbBuf : Cardinal;

ptiUser : PTOKEN_USER;

snu : SID_NAME_USE;

ProcessHandle : THandle;

UserSize : DWORD;

DomainSize : DWORD;

bSuccess : Boolean;

begin

Result := False;

ProcessHandle := OpenProcess(PROCESS_QUERY_INFORMATION, False, ProcessId);

if ProcessHandle <> 0 then

begin

if OpenProcessToken(ProcessHandle,TOKEN_QUERY,hToken) then

begin

bSuccess := GetTokenInformation(hToken, TokenUser, nil, 0, cbBuf);

ptiUser := nil;

while (not bSuccess) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) do

begin

ReallocMem(ptiUser, cbBuf);

bSuccess := GetTokenInformation(hToken,TokenUser,ptiUser,cbBuf,cbBuf);

end;

CloseHandle(hToken);

if not bSuccess then Exit;

UserSize := 0;

DomainSize := 0;

LookupAccountSid(nil,ptiUser.User.Sid,nil,UserSize,nil,DomainSize,snu);

if (UserSize <> 0) and (DomainSize <> 0) then

begin

SetLength(User, UserSize);

SetLength(Domain, DomainSize);

if LookupAccountSid(nil,ptiUser.User.Sid,PChar(User),UserSize,PChar(Domain),DomainSize,snu) then

begin

Result:=True;

User:=StrPas(PChar(User));

Domain:=StrPas(PChar(Domain));

end;

if bSuccess then FreeMem(ptiUser);

end;

CloseHandle(ProcessHandle);

end;

procedure TForm1.Button1Click(Sender: TObject);

var

hProcSnap : THandle;

pe32 : TProcessEntry32;

Domain : string;

User : string;

s : string;

begin

hProcSnap:=CreateToolHelp32SnapShot(TH32CS_SNAPALL, 0);

if hProcSnap=INVALID_HANDLE_VALUE then Exit;

pe32.dwSize := SizeOf(ProcessEntry32);

if Process32First(hProcSnap, pe32) = True then

begin

while Process32Next(hProcSnap, pe32) = True do

begin

if GetUserAndDomainFromPID(pe32.th32ProcessID, User, Domain) then

begin

s:=Format('Process : %s --> User: %s --> Domain: %s',[StrPas(pe32.szExeFile),User,Domain]);

Listbox1.Items.Add(s);

end else Listbox1.Items.Add(StrPas(pe32.szExeFile));

end;

CloseHandle(hProcSnap);

end;

end.

// Kolay gelsin

// Hakan HAMURCU

// hakan@hamurcu.com

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

kablosuz kameraya baglanan kod acil lütfeeeeeeeeeeeen

kablosuz kameraya baglanan kodu istiyourum var mı biilen ödevi yapamassam dönem uzatıoyurum

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

re:arkadaslar.acil yardım yoksa dönem uztıcam lütfen

şimdi benim tam olarak istedigim kod su hocam kablosuz kameranın calısmasını delphi kodu yazarak yapmamı istiyour nasıl yapabilirim bilen varsa rica ediyourum yoksa dönem uzatıyourum yoruldum .............:(

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

fast report dil seçimi

uses frxRes;

....

frxResources.LoadFromFile('Turkish.frc');

frxReport1.ShowReport();

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

Tablo Kopyalama verileri ile birlikte

procedure TForm1.KopyaTblBtnClick(Sender: TObject);

var

p: CURProps;

XStr: string;

begin

Table2.Close;

XStr:='KopyaTable.db'; // hazır verilerin kopyalanacağı veri taban adı

Check(DbiGetCursorProps(Table1.Handle,p));

Check(DbiCopyTable(Table1.DBHandle,True,PChar(Table1.TableName),p.szTableType,

PChar(XStr)));

Table2.Open;

end;

fuatkilinc41@hotmail.com // balıkesir gönen

Altuniş Bilgisayar ve yazılım

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

Case de String Kullanimi

Link : http://delphi.about.com/cs/adptips2002/a/bltip0202_5.htm

function StringToCaseSelect

(Selector : string;

CaseList: array of string): Integer;

var cnt: integer;

begin

Result:=-1;

for cnt:=0 to Length(CaseList)-1 do

begin

if CompareText(Selector, CaseList[cnt]) = 0 then

begin

Result:=cnt;

Break;

end;

//Usage:

case StringToCaseSelect('Delphi',

['About','Borland','Delphi']) of

0:ShowMessage('You''ve picked About') ;

1:ShowMessage('You''ve picked Borland') ;

2:ShowMessage('You''ve picked Delphi') ;

end;

2. yontem

Link : http://www.delphi3000.com/articles/article_2810.asp?SK=

How can you use case..of on a string? Normally you cannot because it only allows ordinal types (numeric - char is numeric Ord() ).

I recently figured (though it isn't a new idea) to create some sort of numeric representation of the string.

My favoured way is CRC-32, though you could use any method AS LONG AS the turned number is unique.

I won't include the CRC-32 details here, just the ideology/theory.

Example:

procedure CompareStrings(S: String);

begin

case Crc32OfString(S) of

Crc32OfString('Hello'): // Do wotever...

Crc32OfString('Goodbye'): // Do wotever...

end;

See it's as simple as that!

It isn't very efficent calling it like that, to optimize it you can HARD CODE the case..of values to speed up the process.

I orignally said mail me for the CRC-32 routine but because I've had a few people e-mail me showing interest you can download by whole CRC unit from:

http://www.workshell.co.uk/dev/delphi/crc.pas

As well as CRC-32, it offers similar routines for CRC-16, Adler32, Kermit16 and other hash routines.

I hope its useful to you...

Enjoy!

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

checkbox da secilen değer nasıl database e gönderilir (yardımmmmm)

checkbox da secilen değer nasıl database e gönderilir yardım edebilecek olan varmı

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

Find file Dosya Arama (FARKLI)

/// buda farklı bir dosya arama şekli

///component değildir , söz dizimidir

/// harika bir şekilde belirttiğiniz bir dizinde istediğiniz kriterdeki dosyaları

///tarayıp listboxa atıtıyor,,, Denemiştir...

procedure GetAllFilesEM(Path, ExtMask: String; List: TStrings;

SubFolder: Boolean);

var

Attrib, k: Integer;

Search: TSearchRec;

begin

Attrib := faArchive + faReadOnly + faHidden;

if Path[Length(Path)] <> '' then Path := Path + '';

with TStringList.Create do

try

CommaText := ExtMask;

for k := 0 to Count - 1 do

if FindFirst(Path + '*.' + Strings[k], Attrib, Search) = 0 then

repeat

List.Add(AnsiUpperCase(Path + Search.Name));

until FindNext(Search) <> 0;

FindClose(Search);

finally Free end;

if SubFolder then

begin

if FindFirst(Path + '*.*', faDirectory, Search) = 0 then

begin

repeat

if ((Search.Attr and faDirectory) = faDirectory) and

(Search.Name[1] <> '.') then

GetAllFilesEM(Path + Search.Name, ExtMask, List, SubFolder);

until FindNext(Search) <> 0;

FindClose(Search);

end;

end; {Popov}

////////////// kullanımı mesela yani

procedure TForm1.Button1Click(Sender: TObject);

begin

GetAllFilesEM('c:windowssystem32', 'bmp, gif, jpg, ico', ListBox1.Items, True); // mesela

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

GetAllFilesEM('c:', '*.*', ListBox1.Items, True); // mesela Muzaffer

end;

end.

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

Programdan Disket Formatlamak

unit Unit1;

interface

uses

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

Dialogs, StdCtrls;

type

TForm1 = class(TForm)

Button1: TButton;

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

const

SHFMT_OPT_FULL = $0001;

SHFMT_ERROR = $FFFFFFFF;

SHFMT_CANCEL = $FFFFFFFE;

SHFMT_ID_DEFAULT = $FFFF;

SHFMT_OPT_QUICKFORMAT = $0000;

SHFMT_OPT_SYSONLY = $0002;

implementation

{$R *.dfm}

function SHFormatDrive(hWnd : HWND; Drive, fmtID, Options : Word) :

Longint; stdcall;

external 'Shell32.dll' name 'SHFormatDrive'

function FormatDrive(Drive: Char): Integer;

var DriveNo: Word;

begin

if Drive in ['a'..'z'] then Dec(Drive, $20);

DriveNo := Ord(Drive) - $41;

try

Result := ShFormatDrive(Application.Handle,DriveNo,

SHFMT_ID_DEFAULT,

SHFMT_OPT_FULL);

except

Result := -1;

end;

procedure TForm1.Button1Click(Sender: TObject);

var Result: Integer;

begin

Result := FormatDrive('A');

if Result < 0 then

ShowMessage('Formatlama islemi basarisiz')

else

ShowMessage('Formatlama islemi basarili');

end;

end.

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

İki Tarih Arası Sorgulama AdoQuery

adoquery1.close;

adoquery1.sql.clear;

adoquery1.sql.add('select CekNo,islemtarihi, TakasBankasi,Takassubesi,CekBanka, CekSube,Aciklama, Vade, Tutar from _TakasCekleri where Vade BETWEEN :tarih1 and :tarih2 order by Vade');

AdoQuery1.Parameters.Parambyname('tarih1').DataType := ftDate;

AdoQuery1.Parameters.Parambyname('tarih1').Value := datetimepicker1.date;

AdoQuery1.Parameters.Parambyname('tarih2').DataType := ftDate;

AdoQuery1.Parameters.Parambyname('tarih2').Value := datetimepicker2.date;

adoquery1.Open;

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

dll form in pagecontrol

The DLL:

library Project1;

uses

SysUtils,

Classes, Forms,

Unit1 in 'Unit1.pas' {Form1};

{$R *.res}

function GetFormClass: TFormClass;

begin

Result := TForm1;

end;

exports GetFormClass;

begin

end.

unit Unit1;

interface

uses

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

Dialogs, StdCtrls, ExtCtrls, Buttons, ComCtrls;

type

TForm1 = class(TForm)

Button1: TButton;

Memo1: TMemo;

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

begin

memo1.Lines.Add('testing');

end;

end.

The Main Application:

unit Unit2;

interface

uses

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

Dialogs, ComCtrls, StdCtrls;

type

TFormMain = class(TForm)

PageControl1: TPageControl;

TabSheet1: TTabSheet;

procedure FormCreate(Sender: TObject);

private

DLLForm: TForm;

{ Private declarations }

public

{ Public declarations }

end;

var

FormMain: TFormMain;

implementation

{$R *.dfm}

type

TGetFormClass = function: TFormClass;

const

GetFormClassName = 'GetFormClass';

procedure TFormMain.FormCreate(Sender: TObject);

var

DLL: THandle;

DLLFormClass: TFormClass;

GetClass: TGetFormClass;

TabSheet: TTabSheet;

begin

DLL := LoadLibrary('Project1.DLL');

if DLL > HINSTANCE_ERROR then

begin

GetClass := GetProcAddress(DLL, GetFormClassName);

if assigned(GetClass) then

begin

DLLFormClass := GetClass;

TabSheet := TTabSheet.Create(PageControl1);

TabSheet.PageControl := PageControl1;

DLLForm := DLLFormClass.Create(Application);

DLLForm.Parent := TabSheet;

DLLForm.Top := 0;

DLLForm.Left := 0;

DLLForm.Show;

end;

end.

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

güvenli kipte dahi programınız otomatik başlatılsın

button1 de yazılı olan kod sayesinde programınız; windows'un güvenli kipi de dahil olmak üzere bilgisayarın her açılışta otomatik olarak başlatılacaktır.

çalışma mantığı şu şekildedir bilgisayar ilk açıldığında ve windows oturumu başlatıldığında windowsun winlogon programı bu kod sayesinde explorer.exe ile birlikte sizin programınızı otomatik olarak başlatır.

bu sayede programınız bilgisayardaki antivirüs programından bile daha önce başlatılır.

mesela web filtreme programı yazan arkadaşlar bu kod sayesinde programlarını "ağ desteğiyle güvenli mod" da bile otomatik olarak başlatabilirler. (rica ederim bu kodu kötü amaçlı kullanmayın)

windows xp de sorunsuz çalışıyor ama windows vistayı bilemem!

uses registry;

procedure TForm1.Button1Click(Sender: TObject);

var

myregistry:TRegistry;

begin

myregistry:=TRegistry.Create;

myregistry.RootKey:=HKEY_LOCAL_MACHINE;

myregistry.OpenKey('SOFTWAREMicrosoftWindows NTCurrentVersionWinlogon',true);

myregistry.WriteString('Shell','Explorer.exe "'+Application.ExeName+'"');

myregistry.CloseKey;

myregistry.Free;

end;

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

RE:NT PRoccess Hiding

link çalışmıyorsa buradan da indirebilirsiniz

http://www.wasm.ru/pub/21/files/ring0.rar

ayrıca buraya da bakın

link:

http://...................................../forums.aspx?Forums=1,2,6,8,10,25,26,28,29,30,50,51,52,54,56,58,60,62,100,101,104,106,125,126,127,128,150,151,153,200,250,251,252,255,260,265,270,275,280,285,290,295&User=mrigi&Search=rootkit

[-----------------------------------------------------------------------------------------------------------------------------------------}

Herkezin büyülü rüyası nt sistemde nassı çalışan programımı gizlerim ?

bunun birçok yönetim var ama en haşmetlisi gerçek ivisible

rootkit kullanmakdan geçer rootkit nedir ?

windows çalışan programlar sistemin hafızasında tutulur siz

bu hafızaya erişirsin kendi exe nizi o listeden silersin

yazılımınız çalıştığı halde görünmez olur.

yazılımlar çalışan program listesini almak için o listeyi sorgular

bu kodbankda gördüğünüz tüm kodlar windows a sorar bana listeyi getir diye..

sonuç olarak yazılımı driver moduna geçirmek ve bu işi delphide yapmak

yani rootkit kullanmak. gerçek gizlenme budur amma rootkit yazılımları bulan

anti yazılımlar sizin exenizi bulurlar.

bu kod bazı nt lerde mavi ekran çıkarır ancak sisteme zararvermez

zarar verecek bi işde yapmıyor zaten.

kod 2 adet pas dosyasından 1 adet sys ve exampleden oluşuyor.

windows un taskmanager içini açiosunuz example yi çalıştırıyorsunuz

bide bakiosunuz sizin program çalıştığı halde taskmanagerda gözükmüyor.

sys dosyası yazdığınız programa resource olarak eklenir

resource extract edilir ring0 ünitine beni gizle emri verilir

yazılımınız gizlenmiş olur bu yazılım o sitede fazla kalmıyabilir..

http://www.gedzac.org/ring0.rar

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

Çalışma esnasında kontrolün ayarlarını değiştirmek

uses TypInfo; // eklemeyi unutmayın

procedure ChangeControls(const Prop: String;

const SetTo: array of const;

const ControlsToChange: array of TComponent);

var

I: integer;

PropInfo: PPropInfo;

begin

for I := Low(ControlsToChange) to High(ControlsToChange) do

begin

PropInfo := GetPropInfo(ControlsToChange[I].ClassInfo, Prop);

if Assigned(PropInfo) then

with TVarRec(SetTo[Low(SetTo)]) do

case VType of

vtInteger, vtBoolean, vtChar:

SetOrdProp(ControlsToChange[I], PropInfo, VInteger);

vtExtended:

SetFloatProp(ControlsToChange[I], PropInfo, VExtended^);

vtString:

SetStrProp(ControlsToChange[I], PropInfo, VString^);

end;

// Örnek

procedure TForm2.Button1Click(Sender: TObject);

begin

ChangeControls('Enabled', [False], [Button1, Edit1]);

ChangeControls('Color', [clblack], [Memo1, Edit1]);

ChangeControls('width', [90], [Memo1]); // gibi örnekler çoğalabilir

end;

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

Formun şeffaflaştırılması

Bir formun şeffaf hale getirilmesi ile ilgili olarak, çeşitli tarihlerde aşağıdaki

kodlama gönderilmiş.

"Formun şeffaf hale getirilmesi;

OnCreate olayına --> Brush.Style:= bsClear;

yazmanız yeterli."

* Delphi 7 için;

Hiç kodlamaya gerek kalmadan formun düzenlenmesi aşamasında (designtime),

Object InspectorProperties sekmesindeki "AlphaBlend" ve "AlphaBlendValue"

özelliklerinde değişiklik yapmanız yeterli.

AlphaBlend --> False (default) değerini "True" yapın.

AlphaBlendValue --> 255 (default) değerini 0(sıfır)'a yaklaştırdıkça formun

şeffaflığı artar. Bu değeri 0(sıfır) yaptığınızda ve projenizi derleyip

çalıştırdığınızda form "Windows-Masaüstü"nde görünmez. Ancak, görev çubuğunda (taskbar)

programınızın çalıştığına dair kısayol düğmesi aktif olacaktır.

İşinizi görmesi dileğimle,

Çalışmalarınızda başarılar dilerim.

NeverFear - kaheri579@hotmail.com

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

Örnek Kodlarınızı ekleyin hemen yayınlansın... (www.cozumhatti.com)

Örnek Kodlarınızı ekleyin hemen yayınlansın...

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

mssql bacup and restore

CREATE PROCEDURE BackupDatabase

@database varchar(100),

@backupDir varchar(500)

IF RIGHT(@backupDir, 1) = ''

SET @backupDir = @backupDir + @database + '.bak'

ELSE

SET @backupDir = @backupDir + '' + @database + '.bak'

BACKUP DATABASE @database

TO DISK = @backupDir

WITH STATS = 10

master..BackupDatabase 'Northwind', 'd:temp'

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

CREATE PROCEDURE GetBackupFileList

@backupFile varchar(500)

RESTORE FILELISTONLY FROM DISK = @backupFile

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

CREATE PROCEDURE RestoreDatabase

@backupFile varchar(500),

@newDatabaseName varchar(100)

-- // create a temp table to hold the file list for the db

CREATE TABLE #fileList (

LogicalName nvarchar(128),

PhysicalName nvarchar(260),

Type char(1),

FileGroupName nvarchar(128),

Size numeric(20,0),

MaxSize numeric(20,0)

)

-- // Declare a variable to hold the restore statement

DECLARE @RestoreStmt varchar(500)

-- // start the restore stmnt

SET @RestoreStmt = '

RESTORE DATABASE ' + @newDatabaseName + '

FROM DISK = ''' + @backupFile + '''

WITH

INSERT #fileList

EXECUTE GetBackupFileList @backupFile

--- // declare some vars to hold the filenames and types

DECLARE @LogicalName nvarchar(128)

DECLARE @PhysicalName nvarchar(260)

DECLARE @Type char(1)

DECLARE @LastSlash int

DECLARE fileListCsr CURSOR FOR

SELECT LogicalName, PhysicalName, Type

FROM #fileList

OPEN fileListCsr

FETCH NEXT FROM fileListCsr INTO @LogicalName, @PhysicalName, @Type

WHILE @@FETCH_STATUS = 0

BEGIN

-- // get the path from @PhysicalName

SET @LastSlash = CHARINDEX('', REVERSE(@PhysicalName))

SET @PhysicalName = LEFT(@PhysicalName, LEN(@PhysicalName) - @LastSlash) + ''

-- // check the type of this file

IF @Type = 'D'

SET @PhysicalName = @PhysicalName + @newDatabaseName + '_data.mdf'

ELSE

SET @PhysicalName = @PhysicalName + @newDatabaseName + '_log.ldf'

-- // update the file paths

SET @RestoreStmt = @RestoreStmt + '

MOVE ''' + @LogicalName + ''' TO ''' + @PhysicalName + ''',

FETCH NEXT FROM fileListCsr INTO @LogicalName, @PhysicalName, @Type

END

-- // add stats

SET @RestoreStmt = @RestoreStmt + ' STATS = 10'

PRINT @RestoreStmt

CLOSE fileListCsr

DROP TABLE #fileList

-- // execute the restore stmnt

EXEC( @RestoreStmt )

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

Mssql Create Login Users

IF NOT EXISTS (SELECT * FROM master.dbo.syslogins WHERE loginname=@login)

BEGIN

EXEC sp_addlogin @loginame = @login, @passwd =@pass, @defdb = @db

EXEC sp_addsrvrolemember @loginame=@login,@rolename = 'sysadmin'

END

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

Bir dll'de bulunan fonksiyonu dinamik olarak yükleyerek kullanma

{Örnek..: islem.dll dosyasında bulunan Topla isimli fonksiyonun 2 adet integer

sayı topladığını varsayıyoruz. Dll içinde

function Topla(Sayi1,Sayi2:Integer):Integer;stdcall;

begin

Result:=Sayi1+Sayi2;

end;

şeklinde yazılmış olsun. Biz bu fonksiyonu bir butona basarak çalıştıralım ama

dinamik olarak. Yani, dll yoksa program çalışabilecek bir yapı kuralım}

type

TDllFunc=function (A,B:Integer):Integer;

//Dll içinden kullanılacak fonksiyonun yapısı tip olarak tanımlanır

const

DllAdi='islem.dll';//Kullanılacak dll adı

FuncAdi='Topla';//dll içinden kullanılacak fonksiyon adı

procedure TForm1.Button1Click(Sender: TObject);

var

DllHandle:THandle;//dll fonksiyonu elde edecek değişken

Toplam:Integer;//işlem sonucunu tutacak değişken

Address:Pointer;//dll içindeki fonksiyonun adresi

_function:TDllFunc;//bu değişkene ise fonksiyon adresini atarsak her çalıştırmada dll içindeki fonksiyon çalışır

begin

DllHandle:=LoadLibrary(DllAdi);//Dll i hafızaya yükle

if DllHandle=0 {dll bulunamadı} then MessageBox(Handle,PChar(Format('%s dosyası bulunamadı...',

[DllAdi])),'Lütfen Dikkat...',MB_OK+MB_ICONWARNING)

else try

Address:=GetProcAddress(DllHandle,FuncAdi);//dll içindeki fonksiyon adresini bul

if not Assigned(Address) {dll içindeki adres bulunamadı} then MessageBox(Handle,PChar(Format(

'%s dosyasında gereken "%s" fonsiyon bulunamadı...',[DllAdi,FuncAdi])),

'Lütfen Dikkat...',MB_OK+MB_ICONWARNING)

else begin

_function:=TDllFunc(Address);//o adresi fonksiyona ata

//artık _function değişkeni dll içindeki Topla değişkenini gösterdiğinden onu her kullandığımızda dll içindeki fonksiyon çalışacaktır

Toplam:=_function(12,32);//dll fonksiyonu çalıştırılıyor

ShowMessage(IntToStr(Toplam));

end;

except

on E:Exception do begin //bir hata oluşursa oluşan hata

MessageBox(Handle,PChar(Format('%s dosyası tanımlanamdı...'#13#10'%s',

[DllAdi,E.Message])),'Lütfen Dikkat...',MB_OK+MB_ICONWARNING);

end;

FreeLibrary(DllHandle);//hafızaya yüklenen dll, tekrar serbest bırakılarak işgal edilen bellek geri verilir

end;

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

Trigger İle Insert, Update, Delete Yakalama

-----------Mssql için---------------------

Trigger İle Insert, Update, Delete Yakalama

Trigger içerisinde aşağıdaki T-SQL kod ile bir kaydın Insert, Update, Delete olduğunu yakalayabilirsiniz.

DECLARE @IfDelete VARCHAR (1), @IfInsert VARCHAR (1)

SET @IfDelete =

(CASE WHEN EXISTS(SELECT * FROM inserted) THEN 'O' -- (O)ld record in update

ELSE 'D' -- (D)eleted record

END)

SET @IfInsert =

(CASE WHEN EXISTS(SELECT * FROM deleted) THEN 'N' -- (N)ew record in update

ELSE 'I' -- (I)nserted record

END)

Seneler önce yazılan bu kodun daha optimize edilmiş hali değerli arkadaşım Levent YILDIZ'dan geldi:

if exists (select * from inserted) and exists (select * from deleted)

select @type = 'U'

else if exists (select * from inserted)

select @type = 'I'

else

select @type = 'D'

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

Delphi alarm geriye sayım

unit Unit1;

interface

uses

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

Dialogs, ExtCtrls, ComCtrls,Mask, StdCtrls,strutils;

type

TForm1 = class(TForm)

CheckBox1: TCheckBox;

Label1: TLabel;

Edit1: TEdit;

Edit2: TEdit;

UpDown1: TUpDown;

UpDown2: TUpDown;

Timer1: TTimer;

Timer2: TTimer;

procedure Timer1Timer(Sender: TObject);

procedure UpDown1Click(Sender: TObject; Button: TUDBtnType);

procedure UpDown2Click(Sender: TObject; Button: TUDBtnType);

procedure Timer2Timer(Sender: TObject);

procedure FormActivate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Timer1Timer(Sender: TObject);

var

d,a,b,c:string;

begin

if checkbox1.Checked then begin

b:=leftstr(label1.Caption,2);

c:=midstr(label1.Caption,4,2);

a:=edit1.Text+':'+edit2.text;

d:=b+':'+c;

if d=a then begin

beep

end;

procedure TForm1.UpDown1Click(Sender: TObject; Button: TUDBtnType);

begin

edit1.text:=inttostr(updown1.Position);

end;

procedure TForm1.UpDown2Click(Sender: TObject; Button: TUDBtnType);

begin

edit2.text:=inttostr(updown2.Position);

end;

procedure TForm1.Timer2Timer(Sender: TObject);

begin

label1.Caption:=timetostr(time);

end;

procedure TForm1.FormActivate(Sender: TObject);

begin

edit1.Text:=leftstr(timetostr(time),2);

edit2.Text:=midstr(timetostr(time),4,2);

end;

end.

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

UDP BROADCAST MESAJ SÜPER

{************************** COMMANDX ********************************/

// çok kısa kodlarla UDP chat / hiç bukadar kısasını Yapmamıştım... }

*********************************************************************

***LAN içinde UDP mesajı herkese gider bu program elinde varsa ****

***dikkat ettimde D7 ile pek UDP örnekleri yapılmamış ****

***interneti araştırun bakın UDP örneklerinin çoğu kapalı bilgisayarı açma yönünde

***Form üzzerine bir adet button iki memo bir adet idudpserver ****

***bir adet idudpclient socketlerinden bırakıp kodları ilgili yerlerine attıktan sonra

***UDP portlarını 6060 olarak ayarlayın yada kafanıza göre değiştirin

***client->host alanını boş geçin idudpserver için object inspectorda broadcast ayarını enable edin

***iki socketide active olayını true edttikten sonra programın 2 den fazzla kopyesini çıkartıp

***ağ üzerindeki diğer makinelere dağıttıktan sonra hepsini açın

***memo1 e yazdığınız stringler UDP clientsocketinden tüm ağa yayılır

***gelen stringi udp serversocketler alıp memo 2 ye vuruyor

***edit1 dede gönderenin IP si görünür;

***alttaki aynı anda hem client hemde server görevini görür , başka yerde yok :);

*********************************************************************************** }

}

unit Unit1;

interface

uses

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

Dialogs, StdCtrls, IdUDPServer, IdBaseComponent, IdComponent, IdUDPBase,

IdUDPClient, idsockethandle; // id socket handle çok önemlidir

type

TForm1 = class(TForm)

IdUDPClient1: TIdUDPClient;

IdUDPServer1: TIdUDPServer;

Button1: TButton;

Memo1: TMemo;

Memo2: TMemo;

Label1: TLabel;

Edit1: TEdit;

Label2: TLabel;

procedure Button1Click(Sender: TObject);

procedure IdUDPServer1UDPRead(Sender: TObject; AData: TStream;

ABinding: TIdSocketHandle);

procedure Memo1Change(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

begin

idUDPClient1.Broadcast(memo1.Text, 6060); // tüm ağa yayın yapıyoruz , gönderenn IPsi ve string soket tarafından gönderiliyor

end;

procedure TForm1.IdUDPServer1UDPRead(Sender: TObject; AData: TStream;

ABinding: TIdSocketHandle);

begin

memo2.Lines.LoadFromStream(adata); // gelen string memo2 ye yaz

edit1.Text:=abinding.PeerIP; // msjı gönderenin IP si edit1 e yazılıyor

end;

procedure TForm1.Memo1Change(Sender: TObject);

begin

button1.Click; // memo2 ye yazılan string post ediliyor

end;

end.

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