Genelbilge.com | nedir, tanımı, anlamı,nasıl yapılır » Delphi

Performance Optimization

admin — Fri, 27 Aug 2010 17:36:18 +0000

First of all, we must divide the process of performance optimization into seven phases:

We need to customize our Delphi compiler and linker options for maximum efficiency. Furthermore, we need to familiarize ourselves with the Windows environment itself we’re targeting.
We must identify bottlenecks, using Turbo Profiler or another profiling or timing tool. We will examine tools to measure the number of times a statement block is executed, and several methods of timing these statement blocks. Statement blocks may be statements, but also procedures, functions, units and whole programs. We can find the performance bottlenecks using these techniques. It will turn out that even small improvements in these bottlenecks will often have more effect than big improvements in non-bottle-neck areas.
We should examine the data structures and algorithms of the bottlenecks found in step 2, and try to find more efficient equivalents. We will see that the largest performance improvements can come from changing algorithms and data structures. A more specific solution to a problem might be less flexible, but can often be an order of a magnitude faster!

After we performed the first four or five steps, we know for certain that the (stand-alone!) executable (EXE, DLL, OCX) is as fast as possible. Yet, this doesn’t mean that the application doesn’t need fine-tuning. Especially in a Client/Server, or N-tier (internet) environment, we need to perform additional steps to ensure maximum efficiency.
During the Delphi Efficiency session in San Diego, we’ll spend some time exploring steps 6. and 7. by building a 2-Tier database application, using TClientDataSet and Providers.

A step can fail in two ways. One way if it simply cannot be done, and another way if it doesn’t deliver the required performance result.

Step 1. Prepare!
Before we even start to think about Performance Optimization, it is time to check out the compiler options of Delphi on our development machine. Although compiler options have less impact than a bad algorithm, it can seriously slow down our code and expand our total code size.
My personal project options for Delphi 32 (Delphi 2.x and higher) are as follows (note the checked “Default”, which means that these options are now default for every new project in Delphi on my machine):
Delphi 4 Project Options

Compared to the 16-bits Delphi Project Options – Compiler page, there are a few new things. There is now an “Optimization” option. Frankly, I don’t know why we should want to have this one turned off. It only takes a fraction longer to debug) the application with and without optimization if needed.
Another change is the “Aligned record fields” option, that will align fields within records to 32-bit boundaries. In Win32 land, this field alignment means faster writing files that contain these (previously non-aligned) records. We must use the new keyword packed in these cases, to make sure the records are packed like before.

Algorithm Analysis
Algorithm analysis focuses on the run-time behavior of the algorithm in space and time efficiency. We often use the Big-Oh notation to express the running-time O(log N) if it takes only “log N” steps to perform the task at hand; like searching honestly, have you ever used binary search when looking for a person’s phone number in the phone book?). We can distinguish the following important O(N) running-time behaviors:

O(N)	Behavior
C	Constant
log N	Logarithmic
N	Linear
N log N	linear-logarithmic
N*N	Quadratic
NNN	Cubic
2**N	Exponential

In practice, we’ll mostly meet algorithms with a Logarithmic, Linear, Linear-logarithmic or Quadratic behavior. An algorithm with a Big-Oh slower than quadratic is often not very practical (even quadratic is often not usable for large input sets). Using this Big-Oh information, we can predict that an algorithm will be slower or faster than another algorithm. A Bubble Sort of O(N2), for example,

is much slower than a Quick Sort which has an average case of O(N log N). Just fill in N=1000 for a list of 1000 elements that needs to be sorted, and we’ll see that Bubble Sort will need O(1,000,000) operations, while Quick Sort can do it in

O(10,000) – the difference between one second and two minutes! For operations, we can substitute a certain amount of work that need to be done in the so-called inner loop of the algorithm.

Ağ sürücülerinin Tespiti

admin — Tue, 17 Mar 2009 12:46:15 +0000

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
ListBox1: TListBox;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

function GetNetworkDriveMappings(
sl : TStrings ) : integer;
var
i : integer;
sNetPath : string;
dwMaxNetPathLen : DWord;
begin
sl.Clear;
dwMaxNetPathLen := MAX_PATH;
SetLength( sNetPath,
dwMaxNetPathLen );
for i := 0 to 25 do
begin
if( NO_ERROR =
Windows.WNetGetConnection(
PChar(
” + Chr( 65 + i ) + ‘:’ ),
PChar( sNetPath ),
dwMaxNetPathLen ) )then
begin
sl.Add( Chr( 65 + i ) + ‘: ‘ +
sNetPath );
end;
end;
Result := sl.Count;
end;

procedure TForm1.Button1Click(Sender: TObject);
//
// here’s how to call GetNetworkDriveMappings():
//
var
sl : TStrings;
nMappingsCount,
i : integer;
begin
sl := TStringList.Create;
nMappingsCount :=
GetNetworkDriveMappings( sl );
for i := 0 to nMappingsCount-1 do
begin
//
//Istenen seyler burada yapilabilir.
// Simdilik sadece görüntülensin
//
MessageBox( 0,
PChar( sl.Strings[ i ] ),
‘Tanimli Ag diskleri’,MB_OK );
end;
listbox1.items.assign(sl);
sl.Free;
end;

end.

Tablodan dosyaya aktarma

admin — Tue, 17 Mar 2009 12:43:08 +0000

unit Exttab;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,dialogs,
Db, DBTables,StdCtrls,ComCtrls,WinTypes, WinProcs, ExtCtrls,DBCtrls;

const
LANGUAGE=’TURKISH’;
REGISTERED=FALSE;

type
TExtTab= class(Ttable)
private
{ Private declarations }
f_message:string;
f_about:string;
f_delimited:boolean;
f_delimeter:string;
f_filename:string;
protected
{ Protected declarations }
public
{ Public declarations }
published
procedure SaveToFile;
property IsDelimited:boolean read f_delimited write f_delimited;
property Delimeter:string read f_delimeter write f_delimeter;
property FilePathAndName:string read f_filename write f_filename;
property About:string read f_about write f_about;
{ Published declarations }
end;

implementation
var msgid:integer;

procedure TExtTab.SaveToFile;
function tamamla(instr:string;x:integer;j:integer):string;
var
l,t:integer;
begin
if (IsDelimited) and (delimeter=”) then delimeter:=’@';

if not isdelimited then
begin
if length(fields[j].fieldname)>=x then
x:=length(fields[j].fieldname);
for l:=1 to x-length(instr) do
instr:=instr+’ ‘;
result:=instr+’ ‘;
end
else result:=instr+delimeter;
end;

var
col_count:integer;
row_count:integer;
z,i,j:integer;
row:string;
f:system.text;
st,et,ft:ttime;
begin
if not active then open;
if FilePathAndName=” then
begin
filepathandname:= InputBox(‘Dikkat’, ‘Dosya ismini belirtiniz!’, ‘c:\TmpName.txt’);
end;

col_count:=fieldcount;
row_count:=recordcount;
rewrite(f,FilePathAndName);
first;
disablecontrols;
st:=time;
for j:=0 to col_count-1 do
write(f,tamamla(fields[j].fieldname,fields[j].displaywidth,j));

writeln(f,”);
for i:=0 to row_count-1 do
begin
for j:=0 to col_count-1 do
begin
if ord(fields[j].datatype)<14 then
begin
row:=tamamla(fields[j].asstring,fields[j].displaywidth,j);
write(f,row);
end;
end;
next;
writeln(f,”);
end;
et:=time;
ft:=et-st;
showmessage(‘Baslangic: ‘+timetostr(st)+’ ‘+’ Bitis: ‘+timetostr(et)+”#10#13+
‘Kayit Sayisi: ‘+inttostr(fieldcount)+’ Kolon X ‘+inttostr(recordcount)+’ Satir.’#10#13+
‘Islem tamam!’);
enablecontrols;
closefile(f);
end;
end.

Aranan alan tabloda var mı?

admin — Tue, 17 Mar 2009 12:32:34 +0000

Function IsField(DatabaseName, TableName, FieldName: String): Boolean;
Var
Query : TQuery;
T : TTable;
i : Integer;
UpperFN : String;
TestFN : String;
Begin
Result := False;
UpperFN := UpperCase(FieldName);
If Not IsTable(DatabaseName, TableName) Then Exit;
Query := TQuery.Create(nil);
T := TTable.Create(nil);
Try
Try
Query.DatabaseName := DatabaseName;
Query.Sql.Clear;
Query.Sql.Add(‘Select ‘);
Query.Sql.Add(‘a.’+FieldName+’ XYZ’);
Query.Sql.Add(‘From’);
If (Pos(‘.DB’, UpperCase(TableName)) > 0) Or
(Pos(‘.DBF’,UpperCase(TableName)) > 0) Then
Begin
Query.Sql.Add(‘”‘+TableName+’” a’);
End
Else
Begin
Query.Sql.Add(TableName+’ a’);
End;
Query.Active := True;
Result := True;
Except
Try
T.Active := False;
T.DatabaseName := DatabaseName;
T.TableName := TableName;
T.Active := True;
If T.FieldDefs.IndexOf(FieldName) > -1 Then
Begin
Result := True;
End
Else
Begin
For i := 0 To T.FieldDefs.Count -1 Do
Begin
TestFN := UpperCase(T.FieldDefs[i].Name);
If TestFN = UpperFN Then
Begin
Result := True;
Break;
End;
End;
End;
T.Active := False;
Except
End;
End;
Finally
Query.Free;
T.Free;
End;
End;

Bir tablo alanındaki değerlerin sağ tarafındaki boşlukların temizlenmesi

admin — Tue, 17 Mar 2009 12:30:16 +0000

Function DBTrimBlanksRight(
DatabaseName : String;
TableName : String;
FieldName : String): Boolean;
Var
Q : TQuery;
S : String;
Begin
{ Result := False;}{zzz}
Q := TQuery.Create(nil);
Try
Q.Active := False;
Q.DatabaseName := DatabaseName;
Q.RequestLive := True;
Q.Sql.Clear;
Q.Sql.Add(‘Select’);
Q.Sql.Add(‘*’);
Q.Sql.Add(‘From’);
Q.Sql.Add(‘”‘+TableName+’”‘);
Q.Active := True;
Q.First;
While Not Q.EOF Do
Begin
S := Q.FieldByName(FieldName).AsString;
S := Trim(S);
S := Trim(S);
Q.Edit;
Q.FieldByName(FieldName).AsString := S;
Q.Post;
Q.Next;
End;
Result := True;
Finally
Q.Free;
End;
End;

Tablo yapıları aynı mı?

admin — Tue, 17 Mar 2009 12:27:42 +0000

Bu fonksiyonda, iki tablonun yapisi karsilastirilir ve ayni ise TRUE degeri döndürülür.
Function DBSchemaSame(const
DatabaseName1,
Table1,
DatabaseName2,
Table2: string): Boolean;
Begin
Result := IsStructureSame(DatabaseName1,Table1,DatabaseName2,Table2);
End;

{!~ Creates a new TSession object.}
{$IFDEF WIN32}
Function DBSessionCreateNew: TSession;
{$ENDIF WIN32}
{$IFDEF WIN32}
Var
List : TStringList;
Seed : String;
i : Integer;
Ses : String;
Begin
Seed := ‘Session’;
Ses := Seed+’0′;
List := TStringList.Create;
Try
Sessions.GetSessionNames(List);
For i := 0 To 1000 Do
Begin
Ses := Seed + IntToStr(i);
If List.IndexOf(Ses) = -1 Then Break;
End;
Result := Sessions.OpenSession(Ses);
Finally
List.Free;
End;
End;
{$ENDIF}

Tablo adının değiştirilmesi

admin — Mon, 16 Mar 2009 09:01:30 +0000

Function DBReNameTable(
DatabaseName,
TableNameOld,
TableNameNew: String): Boolean;
Begin
Result := True;
Try
If Not IsTable(DatabaseName, TableNameOld) Then
Begin
Result := False;
Exit;
End;

{First Copy The Source Table To The New Table}
If Not DBCopyTable(
DatabaseName,
TableNameOld,
DatabaseName,
TableNameNew) Then
Begin
Result := False;
Exit;
End;

{Now Drop The Source Table}
If Not DBDropTable(DatabaseName, TableNameOld) Then
Begin
Result := False;
Exit;
End;
Except
Result := False;
End;
End;

Function DBRecordMove(
SourceDatabaseName,
SourceTable,
DestDatabaseName,
DestTable: String;
BMode: TBatchMode): Boolean;
var S : TTable;
D : TTable;
B : TBatchMove;
begin
S := TTable.Create(nil);
D := TTable.Create(nil);
B := TBatchMove.Create(nil);
try S.Active := False;
S.DatabaseName := SourceDatabaseName;
S.ReadOnly := False;
S.TableName := SourceTable;
S.Active := true;

D.Active := False;
D.DatabaseName := DestDatabaseName;
D.TableName := DestTable;
D.ReadOnly := False;

B.AbortOnKeyViol := False;
B.AbortOnProblem := False;
B.Destination := D;
B.Source := S;
B.Mode := BMode;
Try
B.Execute;
Except
End;

Result := True;
finally
S.Free;
D.Free;
B.Free;
end;
End;

Tablonun anahtar alanların tespiti

admin — Mon, 16 Mar 2009 09:00:25 +0000

Function DBKeyFieldNamesToTStrings(
DatabaseName : String;
TableName : String;
Strings : TStrings): Boolean;
Var
Table : TTable;
FieldNo : Integer;
Begin
Result := False;
If Not IsTable(DatabaseName, TableName) Then Exit;
Table := TTable.Create(nil);
Try
Try
Table.Active := False;
Table.DatabaseName := DatabaseName;
Table.TableName := TableName;
Table.Active := True;
Strings.Clear;
For FieldNo := 0 To Table.FieldDefs.Count -1 Do
Begin
If IsFieldKeyed(
DatabaseName,
TableName,
Table.FieldDefs[FieldNo].Name) Then
Begin
Strings.Add(Table.FieldDefs[FieldNo].Name);
End;
End;
Result := True;
Except
End;
Finally
Table.Free;
End;
End;

Tabloda Alan tiplerinin bulunması

admin — Mon, 16 Mar 2009 08:58:59 +0000

Function TypeField(DatabaseName, TableName, FieldName: String): String;
Var
Table : TTable;
FieldIndex : Integer;
FieldType : TFieldType;
Begin
Result := ”;
If Not IsTable(DatabaseName, TableName) Then Exit;
If Not IsField(DatabaseName, TableName, FieldName) Then Exit;
Table := TTable.Create(nil);
Try
Try
Table.Active := False;
Table.DatabaseName := DatabaseName;
Table.TableName := TableName;
Table.Active := True;
FieldIndex :=
Table.FieldDefs.IndexOf(FieldName);
FieldType :=
Table.FieldDefs[FieldIndex].DataType;

If FieldType=ftUnknown Then Result := ‘Unknown’;
If FieldType=ftString Then Result := ‘String’;
If FieldType=ftSmallInt Then Result := ‘SmallInt’;
If FieldType=ftInteger Then Result := ‘Integer’;
If FieldType=ftWord Then Result := ‘Word’;
If FieldType=ftBoolean Then Result := ‘Boolean’;
If FieldType=ftFloat Then Result := ‘Float’;
If FieldType=ftCurrency Then Result := ‘Currency’;
If FieldType=ftBCD Then Result := ‘BCD’;
If FieldType=ftDate Then Result := ‘Date’;
If FieldType=ftTime Then Result := ‘Time’;
If FieldType=ftDateTime Then Result := ‘DateTime’;
If FieldType=ftBytes Then Result := ‘Bytes’;
If FieldType=ftVarBytes Then Result := ‘VarBytes’;
If FieldType=ftBlob Then Result := ‘Blob’;
If FieldType=ftMemo Then Result := ‘Memo’;
If FieldType=ftGraphic Then Result := ‘Graphic’;
{$IFDEF WIN32}
If FieldType=ftAutoInc Then Result := ‘AutoInc’;
If FieldType=ftFmtMemo Then Result := ‘FmtMemo’;
If FieldType=ftParadoxOle Then Result := ‘ParadoxOle’;
If FieldType=ftDBaseOle Then Result := ‘DBaseOle’;
If FieldType=ftTypedBinary Then Result := ‘TypedBinary’;
{$ENDIF}
Except
End;
Finally
Table.Free;
End;
End;

Tabloda Alan uzunluğunun bulunması

admin — Mon, 16 Mar 2009 08:57:37 +0000

Tablo içerisindeki bir alanın, uzunluğu, bu fonksiyon ile bulunur.

Function DBFieldSize(DatabaseName, TableName, FieldName: String): Integer;
Var
Table : TTable;
FieldIndex : Integer;
FieldSize : Integer;
Begin
Result := 0;
If Not IsTable(DatabaseName, TableName) Then Exit;
If Not IsField(DatabaseName, TableName, FieldName) Then Exit;
Table := TTable.Create(nil);
Try
Try
Table.Active := False;
Table.DatabaseName := DatabaseName;
Table.TableName := TableName;
Table.Active := True;
FieldIndex :=
Table.FieldDefs.IndexOf(FieldName);
FieldSize :=
Table.FieldDefs[FieldIndex].Size;
Result := FieldSize;
Except
End;
Finally
Table.Free;
End;
End;

Tabloda Alan numarasının bulunması

admin — Mon, 16 Mar 2009 08:54:44 +0000

Bu fonksiyon, adi bilinen bir alanın, tablo içerisindeki sırasını bulur.
Function DBFieldNo(DatabaseName, TableName, FieldName: String): Integer;
Var
Table : TTable;
FieldIndex : Integer;
FieldNumber: Integer;
Begin
Result := -1;
If Not IsTable(DatabaseName, TableName) Then Exit;
If Not IsField(DatabaseName, TableName, FieldName) Then Exit;
Table := TTable.Create(nil);
Try
Try
Table.Active := False;
Table.DatabaseName := DatabaseName;
Table.TableName := TableName;
Table.Active := True;
FieldIndex :=
Table.FieldDefs.IndexOf(FieldName);
FieldNumber :=
Table.FieldDefs[FieldIndex].FieldNo;
Result := FieldNumber;
Except
End;
Finally
Table.Free;
End;
End;

Tabloda Alan adının bulunması

admin — Mon, 16 Mar 2009 08:45:32 +0000

Sira numarasi verilen bir tablo alaninin alan adi bu fonksiyonla alinabilir.
Function DBFieldNameByNo(
DatabaseName : String;
TableName : String;
FieldNo : Integer): String;
Var
Table : TTable;
Begin
Result := ”;
If Not IsTable(DatabaseName, TableName) Then Exit;
If FieldNo < 0 Then Exit;
If FieldNo >= DBNFields(DatabaseName, TableName) Then Exit;
Table := TTable.Create(nil);
Try
Try
Table.Active := False;
Table.DatabaseName := DatabaseName;
Table.TableName := TableName;
Table.Active := True;
Result := Table.FieldDefs[FieldNo].Name;
Except
End;
Finally
Table.Free;
End;
End;

Herhangi Bir veritabanından Tablo silme

admin — Mon, 16 Mar 2009 08:43:14 +0000

erhangi bir veri tabanindan tablo silmek gerektiginde, asagidaki fonksiyon kullanilabilir.

Function DBDropTable(const DatabaseName, TableName : string):Boolean;
var Query : TQuery;
begin
Result := False;
If Not IsTable(DatabaseName, TableName) Then
Begin
Exit;
End;
Query := TQuery.Create(nil);
try
Query.DatabaseName := DatabaseName;
Query.SQL.Clear;
Query.SQL.Add(‘Drop Table ‘);
If (Pos(‘.DB’, UpperCase(TableName)) > 0) Or
(Pos(‘.DBF’,UpperCase(TableName)) > 0) Then
Begin
Query.Sql.Add(‘”‘+TableName+’”‘);
End
Else
Begin
Query.Sql.Add(TableName);
End;
Result := True;
Try
Query.ExecSQL;
Except
Result := False;
End;
finally
Query.Free;
end;
end;

Bir dBase (.DBF) tablosundaki silinmiş kayıtların görüntülenmesi

admin — Mon, 16 Mar 2009 08:41:28 +0000

dBase tablolarindaki silinmis kayitlarin görünür hale getirilmesi icin DbiSetProp fonksiyonu kullanilir.

procedure SetDelete(oTable:TTable; Value: Boolean);
var
rslt: DBIResult;
szErrMsg: DBIMSG;
begin
try
oTable.DisableControls;
try
rslt := DbiSetProp(hDBIObj(oTable.Handle), curSOFTDELETEON,
LongInt(Value));
if rslt <> DBIERR_NONE then
begin
DbiGetErrorString(rslt, szErrMsg);
raise Exception.Create(StrPas(szErrMsg));
end;
except
on E: EDBEngineError do ShowMessage(E.Message);
on E: Exception do ShowMessage(E.Message);
end;
finally
oTable.Refresh;
oTable.EnableControls;
end;
end;

dBase tablolarından silinmiş kayıtların atılması

admin — Mon, 16 Mar 2009 08:40:02 +0000

Bu islem icin DbiPackTable. Isimli BDE fonksiyonu kullanilir.
Örnek kod su sekildedir.
uses
DbiProcs, DbiTypes, DBConsts;

procedure TForm1.Button1Click(Sender: TObject);
var
Error: DbiResult;
ErrorMsg: String;
Special: DBIMSG;
begin
table1.Active := False;
try
Table1.Exclusive := True;
Table1.Active := True;
Error := DbiPackTable(Table1.DBHandle, Table1.Handle, nil, szdBASE, True);
Table1.Active := False;
Table1.Exclusive := False;
finally
Table1.Active := True;
end;
case Error of
DBIERR_NONE:
ErrorMsg := ‘Tamam’;
DBIERR_INVALIDPARAM:
ErrorMsg := ‘Tablo belirsiz’ +
‘name is NULL’;
DBIERR_INVALIDHNDL:
ErrorMsg := ‘Veri tabani belirsiz’;
DBIERR_NOSUCHTABLE:
ErrorMsg := ‘Tablo adi belirsiz’;
DBIERR_UNKNOWNTBLTYPE:
ErrorMsg := ‘Tablo tipi belirsiz’;
DBIERR_NEEDEXCLACCESS:
ErrorMsg := ‘Tablo exclusive modda degil’;
else
DbiGetErrorString(Error, Special);
ErrorMsg := ‘[' + IntToStr(Error) + ']: ‘ + Special;
end;
MessageDlg(ErrorMsg, mtWarning, [mbOk], 0);
end;

Tablo içeriğinin TstrinGrid bileşenine doldurulması

admin — Mon, 16 Mar 2009 08:39:04 +0000

Tablo iceriginin TstrinGrid bilesenine doldurulmasi su sekilde olur.
table.first;
row := 0;
grid.rowcount := table.recordCount;
while not table.eof do begin
for i := 0 to table.fieldCount-1 do
grid.cells[i,row] := table.fields[i].asString;
inc (row);
table.next;
end;

Detayı olan bir tablodan kayıt silme

admin — Mon, 16 Mar 2009 08:38:00 +0000

Master-Detay iliski icerisindeki tablolarda, detayi olan bir ana kayit silindiginde, detaylar ortada kalir. Ana kayit olmadigina göre detaylara da ihtiyac yoktur. Bu nedenle ana kayit silinmeden önce detaylari silmek gerekir. Table1 ana tabloya, Table2 de Detay tabloya bagli kabul edilirse, Table1′ den bir kayit silinmek istendiginde önce Table2′ deki detaylar temizlenecektir asagidaki örnek bunu göstermektedir.
procedure TForm1.Table1BeforeDelete(DataSet: TDataset)
begin
with Table2 do begin
DisableControls;
First;
While not EOF do
Delete;
EnableControls;
end;
end;

Mevcut tablodaki kolonların elenmesi

admin — Mon, 16 Mar 2009 08:36:55 +0000

Bir tablodaki alanlarin “Visible” özelligine “False” degeri verilerek, istenmeyen alanlarin görüntülenmesi engellenir.
Table1.FieldByName().Visible := False;
veya
Table1.Field[].Visible := false;

DBMemo içerisinde bir metnin aranması

admin — Mon, 16 Mar 2009 08:35:00 +0000

procedure TForm1.FindDialog1Find(Sender: TObject);
var Buff, P, FT : PChar;
BuffLen : Word;
begin
With Sender as TFindDialog do
begin
GetMem(FT, Length(FindText) + 1);
StrPCopy(FT, FindText);
BuffLen:= DBMemo1.GetTextLen + 1;
GetMem(Buff,BuffLen);
DBMemo1.GetTextBuf(Buff,BuffLen);
P:= Buff + DBMemo1.SelStart + DBMemo1.SelLength;
P:= StrPos(P, FT);
if P = NIL then MessageBeep(0)
else
begin
DBMemo1.SelStart:= P – Buff;
DBMemo1.SelLength:= Length(FindText);
end;
FreeMem(FT, Length(FindText) + 1);
FreeMem(Buff,BuffLen);
DBMemo1.SetFocus;
end;
end;

Yıldız (*****) Şifrelerinin Gösterilmesi

admin — Mon, 16 Mar 2009 08:34:07 +0000

unit AsterixUnt;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Buttons;
var
HSonrakiWinMsg : HWND;

type
TAsterix = class(TForm)
OrnekEdit: TEdit;
Zamanlayici: TTimer;
ShowPanel: TPanel;
Ornek: TLabel;
BitBtn1: TBitBtn;
Bilgi: TLabel;
BilgiLabel: TLabel;
ShowTime: TTimer;
Reklam: TBitBtn;
Ticari: TLabel;
procedure ZamanlayiciTimer(Sender: TObject);
procedure ShowTimeTimer(Sender: TObject);
procedure ReklamClick(Sender: TObject);
private
{ Private declarations }
public
procedure AsterixSifreleriniCoz();
end;

var
Asterix: TAsterix;
implementatio
n

uses Reklam;

{$R *.DFM}

procedure TAsterix.AsterixSifreleriniCoz();
var
HFare : HWND; // Mouse isaretleyici
isaretleyici : TPOINT; // isaretleyici
SifreUzunlugu : integer; // Sifre Uzunlugu
Sifre : string; // Sifre
begin
GetCursorPos(isaretleyici);
HFare := WindowFromPoint(isaretleyici);
if HFare = HSonrakiWinMsg then Exit;
HSonrakiWinMsg := HFare;
if SendMessage(HSonrakiWinMsg, EM_GETPASSWORDCHAR, 0, 0) = 0 then Exit;
SifreUzunlugu := SendMessage(HFare, WM_GETTEXTLENGTH, 0, 0) + 1;
SetLength(Sifre, SifreUzunlugu);
SendMessage(HSonrakiWinMsg, WM_GETTEXT, SifreUzunlugu,LongInt(@Sifre[1]));
ShowPanel.Caption:=’Sifre Uzunlugu = ‘+IntToStr(SifreUzunlugu-1) +’ Buluna Sifre = ‘+PChar(Sifre);
end;

procedure TAsterix.ZamanlayiciTimer(Sender: TObject);
begin
AsterixSifreleriniCoz;
end;

procedure TAsterix.ShowTimeTimer(Sender: TObject);
begin
if not (ShowPanel.Caption=”) then
begin
if ShowPanel.Font.Color=ClBlack then
ShowPanel.Font.Color:=ClRed
else ShowPanel.Font.Color:=ClBlack;
end;
end;

end.

Binary To Decimal Çevrimi

admin — Mon, 16 Mar 2009 08:31:29 +0000

function BinToDec(i:String):integer;
var
sonuc,k,z,katsayi:integer;
begin
katsayi:=1;
sonuc:=0;
For k:=length(i) downto 1 do
begin
z:=strtoint(i[k]);
sonuc:=sonuc+ (z * katsayi);
katsayi:=katsayi*2
end;
BinToDec:=Sonuc;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
Edit1.Text:=inttostr(BintoDec(edit1.text));
end;

Decimal To Binary Çevirimi

admin — Mon, 16 Mar 2009 08:30:20 +0000

function DecToBin(Z:Integer):String;
var
BinString: String;
v,Index: Integer;
begin
Index := 1;
v:=0;
BinString := ”;

Repeat
if index>v then v:=v+4;
BinString := IntToStr(Z mod 2) + BinString;
if (Index mod 4 = 0) then BinString := ‘ ‘ + BinString;
Z := Z div 2;
Inc (Index);
Until (Z=0)and (Index > v);

DecToBin := TrimLeft(BinString);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
Edit1.Text:=Dectobin(strtoint(Edit1.text));
end;

Program calışırken veri tabanı oluşturulması

admin — Mon, 16 Mar 2009 08:29:24 +0000

procedure TForm1.Button1Click(Sender: TObject);
var
Table1: TTable;
begin
Table1 := TTable.Create(Owner);
with Table1 do
begin
DatabaseName := DBDEMOS;
TableName := CDCOLL.DB;

FieldDefs.Clear;
FieldDefs.Add(ADI, ftString, 25, false);
FieldDefs.Add(SOYADI, ftString, 20, false);
FieldDefs.Add(YAS, ftSmallInt, 0, false);

IndexDefs.Clear;
IndexDefs.Add(TITLE, ADI, [ixPrimary, ixUnique]);
end;

Table1.CreateTable;
DataSource1.Dataset := Table1;
Table1.Active := True;
end;

Paradox ve Dbase Veri Dosyalarının Pack Yapılması ve İndex hatalarının düzeltilmesi

admin — Mon, 16 Mar 2009 08:28:10 +0000

procedure ParadoxPack(InTable : TTable); // PARADOX icin
var
bHoldExcl : boolean;
bHoldStat : boolean;
ResCode : DBIResult;
EMessage : DBIMSG;
PdoxTableDesc : CRTblDesc;

begin
ResCode := DBIERR_NONE;
with InTable do
begin
bHoldExcl := Exclusive;
bHoldStat := Active;
Close;
Exclusive := true;
Open;
end;
FillChar( PdoxTableDesc, SizeOf(CRTblDesc), 0);
StrPCopy( PdoxTableDesc.szTblName, InTable.TableName);
PdoxTableDesc.bPack := true;
ResCode := DbiDoRestructure(InTable.DBHandle,
1,
@PdoxTableDesc,
nil,
nil,
nil,
false);
if ResCode <> DBIERR_NONE then
begin
DbiGetErrorString( ResCode, EMessage );
ShowMessage( EMessage );
end;
with InTable do
begin
Close;
Exclusive := bHoldExcl;
Active := bHoldStat;
end;

end;

procedure dbasePack(InTable : TTable); // DBASE icin
var
bHoldExcl : boolean;
bHoldStat : boolean;
ResCode : DBIResult;
EMessage : DBIMSG;

begin

with InTable do
begin
bHoldExcl := Exclusive;
bHoldStat := Active;

Close;
Exclusive := true;
Open;
end;

ResCode := DbiPackTable(InTable.DBHandle,
InTable.Handle,
nil,
nil,
True);

if ResCode <> DBIERR_NONE then
begin
DbiGetErrorString( ResCode, EMessage );
ShowMessage( EMessage );
end;

with InTable do
begin
Close;
Exclusive := bHoldExcl;
Active := bHoldStat;
end;

end;

Bir Stringin Şifrelenmesi ve bu şifrenin çözülmesi

admin — Mon, 16 Mar 2009 08:26:36 +0000

uses WinCRT;

const
KML1 = 52845;
KML2 = 22719;

function Sifrele(const S: String; Key: Word): String;
var
I: byte;
begin
Result[0] := S[0];
for I := 1 to Length(S) do begin
Result[I] := char(byte(S[I]) xor (Key shr 8));
Key := (byte(Result[I]) + Key) * KML1 + KML2;

end;
end;

function SifreCoz(const S: String; Key: Word): String;
var
I: byte;
begin
Result[0] := S[0];
for I := 1 to Length(S) do begin
Result[I] := char(byte(S[I]) xor (Key shr 8));
Key := (byte(S[I]) + Key) * KML1 + KML2;
end;
end;

var
S: string;
begin
Write(‘>’);
ReadLn(S);
S := Sifrele(S,12345);
WriteLn(S);
S := SifreCoz(S,12345);
WriteLn(S);
end.

Kullanılan 16 bitlik bir DLL in hafızadan kaldırılması

admin — Mon, 16 Mar 2009 08:24:19 +0000

procedure TForm1.btnStopClick(Sender: TObject);
var
H: THandle;
begin
H:= GetModuleHandle(‘armdll.dll’);
if H=0 then
ShowMessage(‘DLL is not being used’)
else
begin
ShowMessage(‘DLL is used ‘+IntToStr(GetModuleUsage(H))+’ times’);
while GetModuleUsage(H) > 0 do
FreeModule(H);
ShowMessage(‘Module has been released’);
end;
end;

Şifreleme mantığının kırılması

admin — Mon, 16 Mar 2009 08:21:27 +0000

procedure TForm1.Button1Click(Sender: TObject);
var i,j:longword;
thistime,lasttime:longword;
buffer:array[0..7]of byte;
b:array[0..1]of longword absolute buffer[0];
plaintext:array[0..7]of byte;
p:array[0..1]of longword absolute plaintext[0];
key:array[0..7]of byte;
k:array[0..1]of longword absolute key[0];
begin
lasttime:=gettickcount;
randomize;
if length(edit1.text)<8 then exit;
for i:=0 to 7 do
begin
plaintext[i]:=byte(edit1.text[i+1]);
buffer[i]:=plaintext[i] xor random(256);//encrypt
end;
i:=0;
repeat
for j:=0 to 1000000 do //loop is unrolled by compiler
begin
randseed:=i;
key[0]:=random(256);
key[1]:=random(256);
key[2]:=random(256);
key[3]:=random(256);
key[4]:=random(256);
key[5]:=random(256);
key[6]:=random(256);
key[7]:=random(256);
if b[0] xor k[0]=p[0] then //test key in blocks of 4
if b[1] xor k[1]=p[1] then
begin
thistime:=gettickcount;
caption:=’The key is: ‘+inttostr(i)+’ (‘+inttostr((thistime- lasttime)div 1000)+’sec)’;
Exit;
end;
inc(i,1);
end;
caption:=inttostr(i);
application.processmessages;
until i>longword(MaxInt);
end;

Formu İstenilen bir Objeden Sürüklemek

admin — Mon, 16 Mar 2009 08:19:39 +0000

// Bunu bir objenin on mousedown eventina koyarsaniz
// ve bu kodu eklerseniz o obejeye tiklayip formu sürükleye-
// bilirsiniz
begin
if Button = mbLeft then
begin
ReleaseCapture;
SendMessage(Handle,WM_SYSCOMMAND,SC_MOVE+1,0);
end;
end;

Paradox Şifrenizi unuttuysanız asağıdaki şifrelerle veri tabanını açabilirsiniz …

admin — Mon, 16 Mar 2009 08:18:53 +0000

//*** Default Paradox Sifreleri ***//
Paradox 7.0 ve 5.0 icin “jIGGAe” veya “cupcdvum”
DOS Paradox 4.x icin “nx66ppx”

Birebir Veritabanları arasında Tablo ve veya Query Kopyalanması

admin — Mon, 16 Mar 2009 08:13:29 +0000

function QueryAktar(Query1:TQuery;Query2:TQuery); //Query2 yetine Table2:TTable da kullanilabilinir.
var
HataKod:Boolean;
KayitSayisi,FieldNo:integer;
begin
KayitSayisi:=0;
HataKod:=True;
While (not Query1.Eof) and HataKod do
begin
Query2.insert; //Query icin Request özelligini True yapmalisin burda tablo da kullanilabilinir
for FieldNo:=0 to Query1.FieldCount-1 do
Query2.Fields[FieldNo].AsString:=Query1.Fields[FieldNo].AsString;
// FielNolarini Esitledik ve Ordaki Bilgiyi Kayit ettiriyoruz …
try
Query2.Post;
except
On E:Exception do
begin
HataKod:=False; // Hata Olustu islem yapmasin
// ShowMessage (‘Hata’);
end;
end;
Inc(KayitSayisi); // Kayit Sayisi Arttir
if KayitSayisi mod 3000=0 then
//3000 kayittan sonra update et ve sifirla
begin
Self.Update;
end;
Query1.Next; // Bir sonraki kayit
end;
// islem bitti Queryleri veya tabloyu Kapat
Query1.Close;
Query2.Close;
end;

TablodanKullancı Adı ve Pasword Okumak ve Erişime İzin Vermek

admin — Mon, 16 Mar 2009 08:12:29 +0000

var
Form1: TForm1;
yanlis:byte;
implementation

{$R *.DFM}

procedure TForm1.Button2Click(Sender: TObject);
begin
form1.close;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Table1.open;
Table1.FindKey([edit1.text]); // Tabloda Kullanici Adi Aranir
table1.GotoKey; // Kayda konumlanir
if (table1KULADI.text=edit1.text) and (table1SIFRE.text=edit2.text) then // Kullanici Adi ve Sifreyi Kontrol Eder.
begin
showmessage(‘Kullanici Adi Ve Sifre Dogru’);
end
else
begin
yanlis:=yanlis+1;
if yanlis=3 then // Yanlis Sayisini Kontrol Eder.
begin
showmessage(’3. Kez Kullanici Adi Veya Parolayi Yanlis Girdiniz Program Kapatilacaktir’);
form2.Close;
end;
showmessage(‘Yanlis’);
end;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
yanlis:=0;
end;

end.

Bilgisayarda Yazıcı yüklümü değil mi ?

admin — Mon, 16 Mar 2009 08:10:58 +0000

procedure TForm1.Button1Click(Sender: TObject);
var
Device, Driver, Port : array [0..255] of Char;
Mode : Integer;
begin
Printer.GetPrinter(Device,Driver,Port,Mode);
if Device <> ” then
ShowMessage(Device)// Yazicinin Türü
else
ShowMessage(‘Yazici Bulunamadi’);
end;

Win32 altında Telefon açtırmak

admin — Mon, 16 Mar 2009 08:10:11 +0000

var
hCommFile : THandle;

procedure TForm1.Button1Click(Sender: TObject);
var
PhoneNumber : string;
CommPort : string;
NumberWritten : LongInt;
begin
PhoneNumber := ‘ATDT 0535XXXXXXXXX’+ #13 + #10;
CommPort := ‘COM2′; // Modem Hangi Porttaysa onu ayarlayin
{Portu ac}
hCommFile := CreateFile(PChar(CommPort),
GENERIC_WRITE,
0,
nil,
OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL,
0);
if hCommFile=INVALID_HANDLE_VALUE then
begin
ShowMessage(‘Port Acilamadi’+ CommPort);
exit;
end;

{Telefon numarasini Ara}
NumberWritten:=0;
if WriteFile(hCommFile,
PChar(PhoneNumber)^,
Length(PhoneNumber),
NumberWritten,
nil) = false then begin
ShowMessage(‘Porta yazilamiyor’ + CommPort);
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
{Portu Kapat}
CloseHandle(hCommFile);
end;

EkranKartının ve Diskin Fabrika seri Numarasının Alınması Pascal 7.0 için

admin — Mon, 16 Mar 2009 08:08:31 +0000

program SetDiskSer;

{$A+,B-,D+,E+,F-,G+,I+,L+,N-,O-,P-,Q-,R-,S-,T-,V+,X+,Y+}
{$M 16384,0,655360}

type
TSerPacket = record
Info:Word; { Info level always zero }
SerNo: Longint; { Disk }
Vol: Array[1..11] of char;
FileType: Array[1..8] of char;
end;

var
SPacket: TSerPacket;

function GetSerialInfo(Drive: Byte): Byte; assembler;
asm
mov ah, 69h
mov al, 0 { This is where you 1 set serial, 0 to get serial
number }
mov bl, 1 { drive number 0 = default, 1 = A, 2 = B , 3 = C }
mov dx, offset [SPacket]
int 21h
end;

function SetSerialInfo(Drive: Byte; SerNo: LongInt): Boolean;
var
S: String;
begin
GetSerialInfo(Drive);
SPacket.SerNo := SerNo;
asm
mov ah, 69h
mov al, 1 { This is where you 1 set serial, 0 to get serial
number }
mov bl, Drive { drive number 0 = default, 1 = A, 2 = B ,
3 = C }
mov dx, offset [SPacket]
int 21h
end;
end;

procedure DisplaySerialInfo;
var
S: String;
begin
WriteLn(‘Info level: ‘, SPacket.Info);
WriteLn(‘Serial Num: ‘, SPacket.SerNo);
FillChar(S, SizeOf(S), #0);
Move(SPacket.Vol[1], S[1], 11);
S[0] := #11;
WriteLn(‘Vol: ‘, S);
FillChar(S, SizeOf(S), #0);
Move(Spacket.FileType,S[1], 8);
S[0] := #8;
WriteLn(‘Type: ‘, S);
end;

begin
SetSerialInfo(1, 12); { One means Drive A, 16 is the serial
number } GetSerialInfo(1);
DisplaySerialInfo;
ReadLn;
end.

Cep Telefonları için Genel AT Komutları

admin — Mon, 16 Mar 2009 08:06:59 +0000

Cep Telefonuna Gönderilen AT Komutlari

AT+CBC // Batarya Durumu
AT+CGMI // Üretici Firma
AT+CGMM // Telefonun Modeli
AT+CGSN // Telefonun Seri numarasi
AT+CPBF // Rehberden Buldurma
AT+CPBR // Tüm Adres Defterinin okutulmasi
AT+CPBS // SIM yada Telefonun hafizasinin secilmesi
ATD0535XXXXXXX; // Telefon numarasi cevirme
AT*EKEB=”123456″ // TUSLAMA
AT*EICO=X,Y // X:ICON Y:ON(1)-OFF(0) Mesaj veya diger iconlari degistirme
AT*ESOM=1,”aAffFgaAgfEpgGefgeafDC” // Melodi Yazdirma
AT*ETXT=1,”SELAM” // KARSILAMA MESAJI
AT+COPS? // OPERATORU BELIRTIYOR TURKCELL VEYA TELSIM MI ?
AT+CKPD=”C”,20 // EKRANI TEMIZLE
AT+CKPD=”<",1 // SOL MENUYE GEC
AT+CKPD=”>”,20 // SAG MENUYE GEC
AT*EMMI=1,1,1 //!! oRTADAKI KLAVYE ENABLE 1 DISABLE 0 ENSONDAKI EKRAN ISIGI 1-0
AT+CPBW // Rehbere Telefon numarasi Ekleme
AT+CSQ // Telefonun Sinyal degerinin ölcülmesi
AT+CSMS // Mesaj Servisini Belirle
AT+CMGF // Mesajin Formatini belirle
AT+CSCA // Mesaj Merkezi
AT+CSMP // Text modu telefonun
AT+CSDH // Text Modun paremetrelerini göster
AT+CSCB // Telefondaki Mesaj Ayarini sec
AT+CSAS // Ayarlari Kaydet
AT+CRES // Ayarlari düzenle
AT+CNMI // TE de yeni mesaj indikatörü ac
AT+CMGL // Mesajlari Listele
AT+CMGR // Mesaj Oku
AT+CMGS // Mesaj Gönder
AT+CMSS // Hafizadaki Mesaji Gönder
AT+CMGW // Hafizaya Mesaj Yaz
AT+CMGD // Mesaj Sil
AT+CMGL // Mesajlari Listele
AT+CMGR // Mesajlari Oku
AT+CMGS // Mesaj Gönder
AT+CMGW // Hafizaya Mesaj Yaz

Not : Mesajlari her islemden Sonra konulacak Win98 isletim sistemlerinda DADCom98 cekilmesi gerkiyor
Mesajlariniz icin gulolkml@hotmail.com adresine bildiriniz iyi calismalar …

Form içerisinde hareket

admin — Mon, 16 Mar 2009 08:05:51 +0000

//FORM ICINDE ENTER’A,YUKARI VE ASAGI OKLARA BASILDIGINDA TAB’A GÖRE BIR DIGERINE GITME

procedure TForm1.FormCreate(Sender: TObject);
begin
keyPreview := true;
end;

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
Begin
Key := #0;
PostMessage(Handle, WM_NEXTDLGCTL, 0, 0);
end;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
If key=vk_up then PostMessage(Handle, WM_NEXTDLGCTL, 1, 0);
If key=vk_down then PostMessage(Handle, WM_NEXTDLGCTL, 0, 0);
end;

Kullanilan Com Portları bulma.

admin — Thu, 12 Mar 2009 09:49:46 +0000

function ComPortAvailable(Port: PChar) : boolean;
Var
DeviceName: Array[0..80] of Char;
ComFile: THandle;
begin
StrPCopy(DeviceName, Port);

ComFile := CreateFile(DeviceName, GENERIC_READ or GENERIC_WRITE, 0, Nil,
OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL, 0);

Result := ComFile <> INVALID_HANDLE_VALUE;
CloseHandle(ComFile);
end;

Delphi İle SMS Yollama

admin — Thu, 12 Mar 2009 09:49:07 +0000

procedure TForm1.Button1Click(Sender: TObject);
function Cleanup( sText : string ) : string;
begin
// —
while ( pos( #13, sText ) > 0 ) do
sText[ pos( #13, sText ) ] := ‘ ‘;
while ( pos( #10, sText ) > 0 ) do
delete( sText, pos( #10, sText ), 1 );
result := sText;
end;
var
SoapClient: OleVariant;
v1,
v2,
v3: OleVariant;
begin
SoapClient := CreateOleObject(‘MSSOAP.SoapClient’);
try
SoapClient.mssoapinit(‘http://sal006.salnetwork.com:83/lucin/smsmessaging/process.xml’);
v1 := edtRes.text;
v2 := Cleanup( memBody.Lines.text );
v3 := edtSender.text;
SoapClient.SendTextMessage( v1, v2, v3 );
finally
SoapClient := null;
end;
end;

AnsiUpperCase Veya AnsiLoverCase uygulamasına örnek

admin — Thu, 12 Mar 2009 09:14:04 +0000

function Cevir(Kelime:String;Yon:Boolean):String;
var
Degis,Harf,buyuk,Kucuk:String;
j,i:integer;
begin
Buyuk:=’ABCCDEFGGHIIJKLMNOÖPRSSTUÜVYZQWX’;
Kucuk:=’abccdefgghiijklmnoöprsstuüvyzqwx’;

if Yon=True then //kücükten büyüge cevir degilse büyükten kücüge cevir
begin
For i:=1 to length(Kelime) do
begin
Harf:=Kelime[i];
For j:=1 to 32 do
begin
if Harf=Kucuk[j] then
begin
Harf:=Buyuk[j];
end;
end;
Degis:=Degis+Harf;
end;
end
else
begin
For i:=1 to length(Kelime) do
begin
Harf:=Kelime[i];
For j:=1 to 32 do
begin
if Harf=Buyuk[j] then
begin
Harf:=Kucuk[j];
end;
end;
Degis:=Degis+Harf;
end;
end;

Result:=Degis;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
//Kullanimi
Edit1.text:=Cevir(‘AAA ZZZ’,False)
Edit1.text:=Cevir(‘aaa zzz’,True)
end;

Ayrı bir dosya (program) nasıl calıştırılır? print edilir?

admin — Thu, 12 Mar 2009 09:13:01 +0000

//Ayri bir dosya (program) nasil calistirilir?
//Herhangi bir programi calistirmak icin
ShellExecute(Handle, ‘open’, PChar(‘c:\test\Tanz_AnthroX.exe’), nil, nil, SW_SHOW);
//NOTEPAD’I calistirmak
ShellExecute(Handle, ‘open’, PChar(‘notepad’), nil, nil, SW_SHOW);
//NOTEPAD’e BeniOku.TXT dosyasini actirmak
ShellExecute(Handle, ‘open’, PChar(‘notepad’), PChar(‘c:\AnthroX\benioku.txt’, nil, SW_SHOW);
//Web sayfasini actirmak
ShellExecute(Handle, ‘open’, PChar(‘http://www.genelbilge.com/’), nil, nil, SW_SHOW);
//Print ettirmek
ShellExecute(Handle, ‘print’, PChar(‘c:\test\readme.txt’), nil, nil, SW_SHOW);
//WINDOWS EXPLORER la dizinlere bakmak
ShellExecute(Handle, ‘explore’, PChar(‘c:\windows)’, nil, nil, SW_SHOW);

Excel kayıt boyunu tespit etmek

admin — Thu, 12 Mar 2009 09:10:55 +0000

{uses satirina comobj eklenecek}

procedure TForm1.Button1Click(Sender: TObject);
var
v,sayfa:variant;{v excel prg, sayfa calisma sayfasi}
i:integer;
r:variant;

begin
v:=createoleobject(‘excel.application’);//exceli yarat
v.workbooks.open(‘c:\n.xls’){add};//yeni calisma kitabini ekle
sayfa:=v.workbooks[1].worksheets[1];{Birinci calisma sayfasini sayfa degiskenine ata}
r:=v.activeworkbook.worksheets[1].usedrange;
i:=r.rows.count; // excel kayit sayisi
showmessage(inttostr(i));

v.visible:=true;//Exceli acip verileri goster
end;

Ide’de Servers bölümünde WordApplicationla dosya açma

admin — Thu, 12 Mar 2009 09:10:20 +0000

//IDE Servers bölümündeki Wordapplication ile Dosya acmak
//gerci Comobj ile Oleobj kullanmak daha kolay ama Nokta
//dan sonra prosedür ve metotlari gösterdiginden bu faydali.
//Degiskenler bos birakilmammali, olevariant olarak tanimlanmali.
//Degiskenler hakkinda bilgiyi(tipi vs.) word Visual basic penceresindeki yardimdan ögrenebilirsiniz.

procedure TForm1.Button2Click(Sender: TObject);
var
filename:Olevariant;
s1,s2,s3,s4,s5,s6,s7,s8,s9:Olevariant;
begin
s1:=false;//ConfirmConversions Optional Variant. True
s2:=false;//readonly
s3:=false;//AddToRecentFiles Optional Variant. True
s4:=”;// The password for opening the document.
s5:=”;// The password for opening the template.
s6:=true;//Revert
s7:=”; //The password for saving changes to the document.
s8:=”; //The password for saving changes to the template.
s9:=wdOpenFormatAuto;//format.
wa1.Disconnect;//wordü elle kaparsa hata vermemesi icin
wa1.Connect;
filename:=’d:\worddelphi\ykdsubat2001.doc’;
wa1.Visible:=true;//wordü göster
wa1.Documents.Open(filename,s1,s2,s3,s4,s5,s6,s7,s8,s9);//degisken kac adetse tanimlanmali.

end;
procedure TForm1.Button3Click(Sender: TObject);
begin
wa1.Disconnect;//Word elle kapanirsa hata vermesin diye.
//wordapplication1.Visible:=false;// Bunu kullanma. word cikarken degisiklikleri kaydetmek istiyormusunuz vs. diye sordugunda göremedigin icin acik kaliyor.
wa1.Quit;

end;

Listbox bileşenlerinde renkli satırlar

admin — Thu, 12 Mar 2009 09:09:33 +0000

Bir Tlistbox icerisinde bulunan satirlarin, belli sartlara göre farkli renklerde olmasi mümkündür. Asagidaki kod
örneginde bunun yapilisi gösterilmektedir. Dikkat edilmesi gereken en önemli husus, Listbox bileseninin Style özelligi lbOwnerDrawFixed olmalidir.

//Style= lbOwnerDrawFixed olmali.

procedure TForm1.ListBox1DrawItem(Control: TWinControl;
Index: Integer; Rect: TRect; State:
TOwnerDrawState);
begin
With ( Control As TListBox ).Canvas Do
Begin
Case Index Of
0:
Begin
Font.Color := clBlue;
Brush.Color := clYellow;
End;
1:
Begin
Font.Color := clRed;
Brush.Color := clLime;
End;
2:
Begin
Font.Color := clGreen;
Brush.Color := clFuchsia;
End;
End;
FillRect(Rect);
TextOut(Rect.Left, Rect.Top, ( Control As TListBox
).Items[Index]);
End;
end;

Formun caption alanına buton eklemek

admin — Thu, 12 Mar 2009 09:08:16 +0000

Kullandiginiz formlarin baslik alanina buton ekleyip, bu butona bazi görevler yükleyebilirsiniz.

unit CapBtn;

interface

uses
Windows, Buttons, Messages, SysUtils, Classes, Graphics,
Controls, Forms, Dialogs;

type
TForm1 = class(TForm)
procedure FormResize(Sender: TObject);
private
CaptionBtn : TRect;
procedure DrawCaptButton;
procedure WMNCPaint(var Msg : TWMNCPaint); message
WM_NCPaint;
procedure WMNCActivate(var Msg : TWMNCActivate); message
WM_NCACTIVATE;
procedure WMSetText(var Msg : TWMSetText); message
WM_SETTEXT;
procedure WMNCHitTest(var Msg : TWMNCHitTest); message
WM_NCHITTEST;
procedure WMNCLButtonDown(var Msg : TWMNCLButtonDown);
message WM_NCLBUTTONDOWN;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

const
htCaptionBtn = htSizeLast + 1;
{$R *.DFM}

procedure TForm1.DrawCaptButton;
var
xFrame,
yFrame,
xSize,
ySize : Integer;
R : TRect;
begin
//Form eni ve boyu
xFrame := GetSystemMetrics(SM_CXFRAME);
yFrame := GetSystemMetrics(SM_CYFRAME);

//Baslik butonlarinin eni ve boyu
xSize := GetSystemMetrics(SM_CXSIZE);
ySize := GetSystemMetrics(SM_CYSIZE);

//Yeni butonun yeri
CaptionBtn := Bounds(Width – xFrame – 4*xSize + 2,
yFrame + 2, xSize – 2, ySize – 4);

//Forma ait DC ‘yi kullanarak,
//üzerine cizim yapilacak tuvali bul

Canvas.Handle := GetWindowDC(Self.Handle);
Canvas.Font.Name := ‘Symbol’;
Canvas.Font.Color := clBlue;
Canvas.Font.Style := [fsBold];
Canvas.Pen.Color := clYellow;
Canvas.Brush.Color := clBtnFace;

try
DrawButtonFace(Canvas, CaptionBtn, 1, bsAutoDetect,
False, False, False);
R := Bounds(Width – xFrame – 4 * xSize + 2,
yFrame + 3, xSize – 6, ySize – 7);
with CaptionBtn do
Canvas.TextRect(R, R.Left + 2, R.Top – 1, ‘W’);
finally
ReleaseDC(Self.Handle, Canvas.Handle);
Canvas.Handle := 0;
end;
end;

procedure TForm1.WMNCPaint(var Msg : TWMNCPaint);
begin
inherited;
DrawCaptButton;
end;

procedure TForm1.WMNCActivate(var Msg : TWMNCActivate);
begin
inherited;
DrawCaptButton;
end;

procedure TForm1.WMSetText(var Msg : TWMSetText);
begin
inherited;
DrawCaptButton;
end;

procedure TForm1.WMNCHitTest(var Msg : TWMNCHitTest);
begin
inherited;
with Msg do
if PtInRect(CaptionBtn, Point(XPos – Left, YPos – Top))
then
Result := htCaptionBtn;
end;

procedure TForm1.WMNCLButtonDown(var Msg : TWMNCLButtonDown);
begin
inherited;
if (Msg.HitTest = htCaptionBtn) then
ShowMessage(‘Hoops… yeni butona bastin’);
end;

procedure TForm1.FormResize(Sender: TObject);
begin
//Baslik cubugunun yeniden cizilmesini sagla
Perform(WM_NCACTIVATE, Word(Active), 0);
end;

end.

Masaüstündeki ikonların gizlenmesi

admin — Thu, 12 Mar 2009 09:05:55 +0000

Asagidaki program calistirildiginda, görev cubugu üzerindeki uyari bölümünde bir ikon olarak görünür. Bu
ikon üzerinde tiklandiginda desktop üzerindeki ikonlar saklanir, bir kez daha basildiginda ise geri gelir.

program DeskPop;

uses
Windows, Messages, ShellAPI, sysutils;

{$R *.RES}

const
AppName = ‘DeskTop Sakla’;

var
x: integer;
tid: TNotifyIconData;
WndClass: array[0..50] of char;

procedure Panic (szMessage: PChar);
begin
if szMessage <> Nil then
MessageBox (0, szMessage, AppName, mb_ok);
Halt (0);
end;

procedure HandleCommand (Wnd: hWnd; Cmd: Word);
begin
case Cmd of
Ord (‘A’): MessageBox (0, ‘Merhaba’, AppName, mb_ok);
Ord (‘E’): PostMessage (Wnd, wm_Close, 0, 0);
end;
end;

function DummyWindowProc (Wnd: hWnd; Msg, wParam: Word;
lParam: LongInt): LongInt; stdcall;
var
TrayHandle: THandle;
dc: hDC;
i: Integer;
pm: HMenu;
pt: TPoint;
begin
DummyWindowProc := 0;
StrPCopy(@WndClass[0], ‘Progman’);
TrayHandle := FindWindow(@WndClass[0], nil);
case Msg of
wm_Create:
begin
tid.cbSize := sizeof (tid);
tid.Wnd := Wnd;
tid.uID := 1;
tid.uFlags := nif_Message or nif_Icon or
nif_Tip;
tid.uCallBackMessage := wm_User;
tid.hIcon := LoadIcon (hInstance,
‘MAINICON’);
lstrcpy (tid.szTip,’Desktop is on’);
Shell_NotifyIcon (nim_Add, @tid);
end;
wm_Destroy:
begin
Shell_NotifyIcon (nim_Delete, @tid);
PostQuitMessage (0);
ShowWindow(TrayHandle, SW_RESTORE);
end;
wm_Command:
begin
HandleCommand (Wnd, LoWord (wParam));
Exit;
end;
wm_User: // Had a tray notification – see what to do
if (lParam = wm_LButtonDown) then
begin
if x = 0 then
begin
ShowWindow(TrayHandle, SW_HIDE);
//tid.hIcon := LoadIcon (hInstance, ‘offICON’);
lstrcpy (tid.szTip,’Desktop Kapali’);
Shell_NotifyIcon (NIM_MODIFY, @tid);
x:=1
end else
begin
ShowWindow(TrayHandle, SW_RESTORE);
//tid.hIcon := LoadIcon (hInstance, ‘ONICON’);
lstrcpy (tid.szTip,’Desktop Acik’);
Shell_NotifyIcon (NIM_MODIFY, @tid);
x:= 0;
end;
end else
if (lParam = wm_RButtonDown) then
begin
GetCursorPos (pt);
pm := CreatePopupMenu;
AppendMenu (pm, 0, Ord (‘A’), ‘Hakkinda…’);
AppendMenu (pm, mf_Separator, 0, Nil);
AppendMenu (pm, 0, Ord (‘E’), ‘Kapat’);
SetForegroundWindow (Wnd);
dc := GetDC (0);
if TrackPopupMenu (pm, tpm_BottomAlign or tpm_RightAlign,
pt.x,GetDeviceCaps(dc,HORZRES){pt.y}, 0, Wnd, Nil) then
SetForegroundWindow (Wnd);
DestroyMenu (pm)
end;
end;

DummyWindowProc := DefWindowProc (Wnd, Msg, wParam, lParam);
end;

procedure WinMain;
var
Wnd: hWnd;
Msg: TMsg;
cls: TWndClass;
begin
{ Previous instance running ? If so, exit }
if FindWindow (AppName, Nil) <> 0 then exit;
//Panic (AppName + ‘ is already running.’);

{ window Sinifini kaydettir }
FillChar (cls, sizeof (cls), 0);
cls.lpfnWndProc := @DummyWindowProc;
cls.hInstance := hInstance;
cls.lpszClassName := AppName;
RegisterClass (cls);

{ Bos pencereyi yarat }
Wnd := CreateWindow (AppName, AppName,
ws_OverlappedWindow,
cw_UseDefault, cw_UseDefault,
cw_UseDefault, cw_UseDefault,
0, 0, hInstance, Nil);
x:= 0;
if Wnd <> 0 then
begin
ShowWindow (Wnd, sw_Hide);
while GetMessage (Msg, 0, 0, 0) do
begin
TranslateMessage (Msg);
DispatchMessage (Msg);
end;
end;
end;

begin
WinMain;
end.

Edit bileşeninde sadece sayı yazmak

admin — Thu, 12 Mar 2009 09:03:40 +0000

Function rakam(Key:Char):Char;
Begin
IF (Key>=’0′) And (Key<='9') Or (Key=#8) Or (Key=#13) Then
Begin
Result:=Key;
end
else Result:=Chr(0);
end;

//Kullanimi:

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
Key:=rakam(key);
end;

Çalışma Esnasında Program İçerisinden Bileşen Yaratma…

admin — Thu, 12 Mar 2009 08:29:39 +0000

var
Label1: TLabel ;
ComboBox1:TComboBox;
SpinEdit1:TSpinEdit;
DateTimePicker1:TDateTimePicker;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
Begin
//Label1 Bileseni Olusturuldu
Label1 := TLabel.Create(self) ;
With Label1 Do Begin
Parent:=Self;
Left := 5;
Top := 70;
Width := 70;
Height := 13;
Alignment := taRightJustify;
AutoSize := False;
Caption := ‘Listeler:’;
end;
//ComboBox1 Bileseni Olusturuldu
ComboBox1:=TComboBox.Create(self);
With ComboBox1 Do Begin
Parent:=Self;
Left := 85;
Top := 65;
Width := 145;
Height := 21;
ItemHeight := 13;
TabOrder := 3;
Text := ‘Liste1′;
Items.Clear;
Items.Add(‘Liste1′);
Items.Add(‘Liste2′);
Items.Add(‘Liste3′);;
end;
//DateTimePicker1 Bileseni Olusturuldu
DateTimePicker1:=TDateTimePicker.Create(self);
With DateTimePicker1 Do Begin
Parent:=Self;
Left := 85;
Top := 90;
Width := 146;
Height := 21;
CalAlignment := dtaLeft;
Date := 36964.028340625;
Time := 36964.028340625;
DateFormat := dfShort;
DateMode := dmComboBox;
Kind := dtkDate;
ParseInput := False;
TabOrder := 4;
end;
end;

İşletim sistemi tipinin alınmasi (Windows 95, NT)

admin — Thu, 12 Mar 2009 08:28:11 +0000

if Win32Platform = VER_PLATFORM_WIN32_NT then
ShowMessage(‘NT isletim sistemi’)
else if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then
ShowMessage(95/98/ME Sürümü’)

Harici bir ortamdan basılan tusu anlamak Keyboard Hook

admin — Thu, 12 Mar 2009 08:26:32 +0000

{*************************************************************}
{ TKeySpy Component for Delphi 16/32 }
{ Version: 2.8 }
{ E-Mail: info@utilmind.com }
{ Home page: www.utilmind.com }
{ Created: August, 16, 1998 }
{ Modified: June, 6, 2000 }
{ Legal: Copyright (c) 1998-2000, UtilMind Solutions }
{*************************************************************}
{ KEYBOARD SPY: }
{ This component is intended for interception of pressing the }
{ keyboard. The KeySpy is possible to apply for interception }
{ of the typed text of the another’s programs, as keyboard }
{ spy, or for processing events at type certain keywords etc..}
{*************************************************************}
{ Properties: ************************************************}
{ Enabled: As it usual… }
{ Keyword: At a set of this word event will be }
{ carried out (See OnKeyword event). }
{ ActiveLayout: Active keyboard layout (string) Win32 only }
{ SpyLayout: now present English, Russian, German }
{ & Italian }
{ActiveWindowTitle: Title of active window (Read only) }
{ Events: ************************************************}
{ OnKeySpyDown: As OnKeyDown, but in any place (window). }
{ OnKeySpyUp: As OnKeyUp, but in any place (window). }
{ OnKeyword: The Keyword has been typed (See Keyword). }
{ OnLayoutChanged: The Keyboard layout was changed. Win32 only}
{ OnActiveWindowChanged: }
{*************************************************************}
{ IMPORTANT NOTE: }
{ This code may be used and modified by anyone so long as }
{ this header and copyright information remains intact. By }
{ using this code you agree to indemnify UtilMind Solutions }
{ from any liability that might arise from its use. You must }
{ obtain written consent before selling or redistributing }
{ this code. }
{*************************************************************}
{ Changes: }
{ 20.I.1999: Added 32-bit support }
{ 14.V.1999: Added OnChangeLayout event. }
{ Added Italian and Russian keyboard layouts. }
{ 28.V.1999: Added ActiveWindowTitle property. }
{ 27.VII.1999: Added Portugese keyboard layout. }
{ Thanks to Tiago Correia (tcorreia@cnotinfor.pt)}
{ 19.IX.1999: Added German keyboard layout (added by Slaine, }
{ slaine@redseven.de) }
{ 5.V.2000: Added French keyboard layout (added by Vincent }
{ CALLIES, thraxsivae@hotmail.com) }
{*************************************************************}
unit KeySpy;

interface

uses
{$IFDEF WIN32} Windows, {$ELSE} WinTypes, WinProcs,{$ENDIF}
SysUtils, Controls, Classes, Messages, Forms;

type
TSpyLayout = (klAmerican, klItalian, klRussian, klPortuguese, klGerman, klFrench);
TOnKeySpy = procedure(Sender: TObject; Key: Byte; KeyStr: String) of object;
{$IFDEF Win32}
TOnLayoutChanged = procedure(Sender: TObject; Layout: String) of object;
{$ENDIF}
TOnActiveWindowChanged = procedure(Sender: TObject; ActiveTitle: String) of object;
TKeySpy = class(TComponent)
private
{$IFDEF Win32}
CurrentLayout: String;
FActiveLayout: String;
{$ENDIF}
CurrentActiveWindowTitle: String;
FActiveWindowTitle: String;
FSpyLayout: TSpyLayout;
FWindowHandle: HWnd;
FOnKeySpyDown, FOnKeySpyUp: TOnKeySpy;
FOnKeyword: TNotifyEvent;
{$IFDEF Win32}
FOnLayoutChanged: TOnLayoutChanged;
{$ENDIF}
FOnActiveWindowChanged: TOnActiveWindowChanged;
FEnabled: Boolean;
FKeyword,
KeyComp: String;

OldKey: Byte;
LShiftUp, RShiftUp: Boolean;
procedure UpdateTimer;
procedure SetEnabled(Value: Boolean);
procedure SetKeyword(Value: String);
procedure WndProc(var Msg: TMessage);
procedure SetNothingStr(Value: String);
protected
procedure KeySpy; dynamic;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property ActiveWindowTitle: String read FActiveWindowTitle write SetNothingStr;
property Enabled: Boolean read FEnabled write SetEnabled;
property Keyword: String read FKeyword write SetKeyword;
property SpyLayout: TSpyLayout read FSpyLayout write FSpyLayout;
{$IFDEF Win32}
property ActiveLayout: String read FActiveLayout write FActiveLayout;
{$ENDIF}
property OnKeySpyDown: TOnKeySpy read FOnKeySpyDown write FOnKeySpyDown;
property OnKeySpyUp: TOnKeySpy read FOnKeySpyUp write FOnKeySpyUp;
property OnKeyword: TNotifyEvent read FOnKeyword write FOnKeyword;
{$IFDEF Win32}
property OnLayoutChanged: TOnLayoutChanged read FOnLayoutChanged write FOnLayoutChanged;
{$ENDIF}
property OnActiveTitleChanged: TOnActiveWindowChanged read FOnActiveWindowChanged write FOnActiveWindowChanged;
end;

procedure Register;

implementation

{$I KLayouts.inc}

constructor TKeySpy.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
LShiftUp := True;
RShiftUp := True;
FEnabled := True;
FWindowHandle := AllocateHWnd(WndProc);
if FEnabled then UpdateTimer;
end;

destructor TKeySpy.Destroy;
begin
FEnabled := False;
UpdateTimer;
DeallocateHWnd(FWindowHandle);
inherited Destroy;
end;

procedure TKeySpy.WndProc(var Msg: TMessage);
begin
with Msg do
if Msg = WM_TIMER then
try
KeySpy;
except
Application.HandleException(Self);
end
else
Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);
end;

procedure TKeySpy.UpdateTimer;
var
b: Byte;
begin
KillTimer(FWindowHandle, 1);
if FEnabled then
begin
asm
mov al, 60h
mov b, al
end;
OldKey := b;
if SetTimer(FWindowHandle, 1, 1, nil) = 0 then
raise EOutOfResources.Create(‘No timers’);
end;
end;

procedure TKeySpy.SetEnabled(Value: Boolean);
begin
if Value <> FEnabled then
begin
FEnabled := Value;
UpdateTimer;
end;
end;

procedure TKeySpy.SetKeyword(Value: String);
begin
Value := LowerCase(Value);
if Value <> FKeyword then
FKeyword := Value;
end;

procedure TKeySpy.KeySpy;
var
PC: Array[0..$FFF] of Char;
Key: Byte;
St: String;
Wnd: hWnd;
begin
{$IFDEF Win32}
Wnd := GetForegroundWindow;
{$ELSE}
Wnd := GetActiveWindow;
{$ENDIF}
SendMessage(Wnd, wm_GetText, $FFF, LongInt(@PC));
FActiveWindowTitle := StrPas(PC);
if CurrentActiveWindowTitle <> FActiveWindowTitle then
begin
CurrentActiveWindowTitle := FActiveWindowTitle;
if Assigned(FOnActiveWindowChanged) then
FOnActiveWindowChanged(Self, FActiveWindowTitle);
end;

{$IFDEF Win32}
GetKeyboardLayoutName(PC);
FActiveLayout := StrPas(PC);
if (FActiveLayout <> CurrentLayout) then
begin
CurrentLayout := FActiveLayout;
if Assigned(FOnLayoutChanged) then
FOnLayoutChanged(Self, FActiveLayout);
end;
{$ENDIF}

asm
in al, 60h
mov Key, al
end;
if Key = 170 then
begin
Key := 84;
LShiftUp := True;
end;
if Key = 182 then
begin
Key := 85;
RShiftUp := True;
end;
if Key = 42 then LShiftUp := False;
if Key = 54 then RShiftUp := False;
if Key <> OldKey then
begin
OldKey := Key;
if Key <= 88 then
begin
case FSpyLayout of
klAmerican: if LShiftUp and RShiftUp then
St := StrPas(LowButtonName[Key])
else
St := StrPas(HiButtonName[Key]);
klItalian: if LShiftUp and RShiftUp then
St := StrPas(ItalianLowButtonName[Key])
else
St := StrPas(ItalianHiButtonName[Key]);
klRussian: if LShiftUp and RShiftUp then
St := StrPas(RussianLowButtonName[Key])
else
St := StrPas(RussianHiButtonName[Key]);
klPortuguese: if LShiftUp and RShiftUp then
St := StrPas(PortugueseLowButtonName[Key])
else
St := StrPas(PortugueseHiButtonName[Key]);
klGerman: if LShiftUp and RShiftUp then
St := StrPas(GermanLowButtonName[Key])
else
St := StrPas(GermanHiButtonName[Key]);
klFrench: if LShiftUp and RShiftUp then
St := StrPas(FrenchLowButtonName[Key])
else
St := StrPas(FrenchHiButtonName[Key]);
end;
if Assigned(FOnKeySpyDown) then
FOnKeySpyDown(Self, Key, St);

if Assigned(FOnKeyword) then
begin
KeyComp := KeyComp + St;
if Length(KeyComp) > Length(FKeyword) then
begin
Move(KeyComp[Length(St) + 1], KeyComp[1], Length(KeyComp));
{$IFDEF WIN32}
SetLength(KeyComp, Length(FKeyword));
{$ELSE}
KeyComp[0] := char(Length(FKeyword));
{$ENDIF}
end;
if LowerCase(KeyComp) = FKeyword then
FOnKeyword(Self);
end;
end
else
if Key – 128 <= 88 then
begin
case FSpyLayout of
klAmerican: if LShiftUp and RShiftUp then
St := StrPas(LowButtonName[Key - 128])
else
St := StrPas(HiButtonName[Key - 128]);
klItalian: if LShiftUp and RShiftUp then
St := StrPas(ItalianLowButtonName[Key - 128])
else
St := StrPas(ItalianHiButtonName[Key - 128]);
klRussian: if LShiftUp and RShiftUp then
St := StrPas(RussianLowButtonName[Key - 128])
else
St := StrPas(RussianHiButtonName[Key - 128]);
klPortuguese: if LShiftUp and RShiftUp then
St := StrPas(PortugueseLowButtonName[Key - 128])
else
St := StrPas(PortugueseHiButtonName[Key - 128]);
klGerman: if LShiftUp and RShiftUp then
St := StrPas(GermanLowButtonName[Key - 128])
else
St := StrPas(GermanHiButtonName[Key - 128]);
klFrench: if LShiftUp and RShiftUp then
St := StrPas(FrenchLowButtonName[Key - 128])
else
St := StrPas(FrenchHiButtonName[Key - 128]);
end;
if Assigned(FOnKeySpyUp) then
FOnKeySpyUp(Self, Key, St)
end;
end;
end;

procedure TKeySpy.SetNothingStr(Value: String); begin {} end;

procedure Register;
begin
RegisterComponents(‘UtilMind’, [TKeySpy]);
end;

end.

Şifre programı db ve özzelikle veri tabanları için güzel bir program

admin — Thu, 12 Mar 2009 08:25:02 +0000

var tur:byte //en üsteki varin altina yazilacak kolay gelsin
begin
tur:=tur+1;
if (edit1.text=’alkan’) and (edit2.text=’ismail’)then
form6.show

else
showmessage(edit1.text+’ yanlisparola’);
edit1.text:=”;
edit2.text:=”;
if tur=3 then HALT;
end;

.avi Dosyalarını Fullscreen oynatma( aviden başka da olabilir)

admin — Thu, 12 Mar 2009 08:17:14 +0000

Gerekenler:
1 Mediaplayer
2 Button
3 Panel “aligin cilent olacak”

procedure TForm1.Button1Click(Sender: TObject);
begin
MediaPlayer1.FileName:=’c:\hands.avi’;
MediaPlayer1.Open;
MediaPlayer1.Display := panel1;
MediaPlayer1.DisplayRect := Rect(0 , 0, Form1.Clientwidth, Form1.ClientHeight); //avi dosyasini panel e yayyarak genisletme komutu//
MediaPlayer1.Play;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
button1.click ;
end;

end.

Programın aynı anda sadece bir kez calışması

admin — Thu, 12 Mar 2009 08:16:13 +0000

function AlreadyLoaded: Boolean;
var wHandle: Integer;
wTitle: array[0..100] of Char;
wClass: array[0..100] of Char;
begin
StrPCopy(wTitle, Application.Title);
StrPCopy(wClass, ‘TApplication’);
Application.Title := ‘$Test$’;
wHandle := findWindow(wClass, wTitle);
Application.Title := wTitle;
Result := wHandle <> 0;
if Result then
begin
ShowWindow(wHandle, SW_SHOWNORMAL);
SetForegroundWindow(wHandle);
end;
end;

Popup Menüyü Kod İle Gösterme 2 Mouse’un bulunduğu pozisyonun alıması

admin — Mon, 09 Mar 2009 20:59:40 +0000

procedure OpenPopupMenu( aPopupMenu : TPopupMenu);
var p : TPoint;
begin
GetCursorPos(p);// mouse ‘in bulundugu yer aliniyor
aPopupMenu.Popup(p.x, p.y);//popup menu aciliyor
end;

// kullanimi

procedure TForm1.Button1Click(Sender: TObject);
begin
OpenPopupMenu( PopupMenu1);
end;

Popup Menüyü Kod İle Gösterme

admin — Mon, 09 Mar 2009 20:58:49 +0000

PopupMenu1.Popup(Form1.Left+60,Form1.Top+140);

VeriTabanından Excele Aktarım

admin — Mon, 09 Mar 2009 20:58:18 +0000

{Form üzerine ole serverla baglanti kurmak icin “servers” bilesenlerinden “ExcelApplication” nesnesini eklemeniz gerekir.
IRange.AutoFormat(6,Null,Null,Null,Null,Null,Null); Bu Satirdaki Rakami 1-15 arasinada Degistirerek degisik Formatlar elde edebilirsiniz}

procedure TForm1.Button1Click(Sender: TObject);
var IRange : Excel97.Range;
i,Row : integer;

begin

if not ExcelApplication1.Visible[0] then //excel acikmi
begin
excelApplication1.Visible[0]:= True; //acik degilse ac
excelApplication1.Workbooks.Add(NULL,0); //yeni calisma kitabi olustur
end
else //excel aciksa yeni calisma sayfasi ekle
excelApplication1.Sheets.Add(Null,null,null,null,1);

// Alan Basliklarini aktar
IRange := excelApplication1.ActiveCell;
for i := 0 to Table1.Fields.count-1 do
begin
IRange.Value := Table1.Fields[i].DisplayLabel;
IRange := IRange.Next;
end;

// Kayitlari Aktar

Table1.DisableControls;
try
Table1.First;
Row :=2;
while Not Table1.Eof do
begin
IRange := ExcelApplication1.Range['A'+IntToStr(Row),'A'+IntToStr(Row)];
for i := 0 to Table1.Fields.Count-1 do
begin
IRange.Value := Table1.Fields[i].Value;
IRange := IRange.Next;
end;
Table1.Next;
Inc(Row);
end;

finally

Table1.EnableControls;
end;
// Auto format

IRange:= ExcelApplication1.Range['A1','D'+IntToStr(Row-1)];
IRange.AutoFormat(6,Null,Null,Null,Null,Null,Null);
end;

Programdan çıkarken bitirme diyaloğu için faydalı bir fonksiyon

admin — Mon, 09 Mar 2009 20:57:42 +0000

FUNCTION ProgrammExit(Text:STRING):BOOLEAN;
BEGIN
RESULT:=MessageDlg(Text,mtConfirmation,[mbYes,mbNo],0)=mrYes;
END;

Kullanimi

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose:=ProgrammExit(‘Kapatmakmi istiyorsunuz?’);
end;
*)

IF Sart THEN Bilgi:=’Bilgi-1 ELSE Bilgi:=’Bilgi-2′; şart cümleleri icin kısa bir yol

admin — Mon, 09 Mar 2009 20:56:33 +0000

FUNCTION Eger(Sart:BOOLEAN;aEvetStr,aHayirStr:STRING):STRING;
BEGIN
IF Sart THEN RESULT:=aEvetStr
ELSE RESULT:=aHayirStr;
END;

//Kullanimi
//ShowMessage(Eger(Dil=’T',’Dil:Türkce’,'Dil:Almanca’);

Ini-Dosyasının yapılan yazılı işlemlerden sonra hemen tazelenmesi

admin — Mon, 09 Mar 2009 20:55:54 +0000

PROCEDURE IniRefresh(F:TFileName);
BEGIN
WriteProfileString(NIL,NIL,PChar(F));
END;

Program içinden herhangi bir tusa basıldığında TAB-tusuna basılmış gibi davranması

admin — Mon, 09 Mar 2009 20:55:12 +0000

PROCEDURE TabByKey(TabKey,Key:CHAR;FormHandle:THandle);
BEGIN
IF TabKey=Key THEN SendMessage(FormHandle,WM_NEXTDLGCTL,0,0);
END;

(*Örnek bir Formularin KeyPress-Olayinda kullanilabilir
TabByKey(#13,Key,Handle);
*)

internet bağlantı tipinin bulunması

admin — Mon, 09 Mar 2009 20:54:03 +0000

Function ConnectionKind :boolean;
var
flags: dword;
begin
Result := InternetGetConnectedState(@flags, 0);
if Result then
begin
if (flags and INTERNET_CONNECTION_MODEM) = INTERNET_CONNECTION_MODEM then
begin
showmessage(‘Modem’);
end;
if (flags and INTERNET_CONNECTION_LAN) = INTERNET_CONNECTION_LAN then
begin
showmessage(‘LAN’);
end;
if (flags and INTERNET_CONNECTION_PROXY) = INTERNET_CONNECTION_PROXY then
begin
showmessage(‘Proxy’);
end;
if (flags and INTERNET_CONNECTION_MODEM_BUSY)=INTERNET_CONNECTION_MODEM_BUSY then
begin
showmessage(‘Modem Busy’);
end;
end;
end; /////kulanim
procedure TForm1.Button3Click(Sender: TObject);
begin
ConnectionKind ;
end;

Hdd seri(fabrika) numarası alınması

admin — Mon, 09 Mar 2009 20:53:18 +0000

function GetIdeSerialNumber ():string;
const IDENTIFY_BUFFER_SIZE = 512;
type
TIDERegs = packed record
bFeaturesReg : BYTE; // Used for specifying SMART “commands”.
bSectorCountReg : BYTE; // IDE sector count register
bSectorNumberReg : BYTE; // IDE sector number register
bCylLowReg : BYTE; // IDE low order cylinder value
bCylHighReg : BYTE; // IDE high order cylinder value
bDriveHeadReg : BYTE; // IDE drive/head register
bCommandReg : BYTE; // Actual IDE command.
bReserved : BYTE; // reserved for future use. Must be zero.
end;
TSendCmdInParams = packed record
// Buffer size in bytes
cBufferSize : DWORD;
// Structure with drive register values.
irDriveRegs : TIDERegs;
// Physical drive number to send command to (0,1,2,3).
bDriveNumber : BYTE;
bReserved : Array[0..2] of Byte;
dwReserved : Array[0..3] of DWORD;
bBuffer : Array[0..0] of Byte; // Input buffer.
end;
TIdSector = packed record
wGenConfig : Word;
wNumCyls : Word;
wReserved : Word;
wNumHeads : Word;
wBytesPerTrack : Word;
wBytesPerSector : Word;
wSectorsPerTrack : Word;
wVendorUnique : Array[0..2] of Word;
sSerialNumber : Array[0..19] of CHAR;
wBufferType : Word;
wBufferSize : Word;
wECCSize : Word;
sFirmwareRev : Array[0..7] of Char;
sModelNumber : Array[0..39] of Char;
wMoreVendorUnique : Word;
wDoubleWordIO : Word;
wCapabilities : Word;
wReserved1 : Word;
wPIOTiming : Word;
wDMATiming : Word;
wBS : Word;
wNumCurrentCyls : Word;
wNumCurrentHeads : Word;
wNumCurrentSectorsPerTrack : Word;
ulCurrentSectorCapacity : DWORD;
wMultSectorStuff : Word;
ulTotalAddressableSectors : DWORD;
wSingleWordDMA : Word;
wMultiWordDMA : Word;
bReserved : Array[0..127] of BYTE;
end;
PIdSector = ^TIdSector;
TDriverStatus = packed record
// Error code from driver, or 0 if no error.
bDriverError : Byte;
// Contents of IDE Error register. Only valid when bDriverError is SMART_IDE_ERROR.
bIDEStatus : Byte;
bReserved : Array[0..1] of Byte;
dwReserved : Array[0..1] of DWORD;
end;
TSendCmdOutParams = packed record
// Size of bBuffer in bytes
cBufferSize : DWORD;
// Driver status structure.
DriverStatus : TDriverStatus;
// Buffer of arbitrary length in which to store the data read from the drive.
bBuffer : Array[0..0] of BYTE;
end;

var
hDevice : THandle;
cbBytesReturned : DWORD;
ptr : PChar;
SCIP : TSendCmdInParams;
aIdOutCmd : Array [0..(SizeOf(TSendCmdOutParams)+IDENTIFY_BUFFER_SIZE-1)-1] of Byte;
IdOutCmd : TSendCmdOutParams absolute aIdOutCmd;

procedure ChangeByteOrder( var Data; Size : Integer );
var ptr : PChar;
i : Integer;
c : Char;

begin
ptr := @Data;
for i := 0 to (Size shr 1)-1 do
begin
c := ptr^;
ptr^ := (ptr+1)^;
(ptr+1)^ := c;
Inc(ptr,2);
end;
end;

begin
Result := ”; // return empty string on error
if SysUtils.Win32Platform=VER_PLATFORM_WIN32_NT then // Windows NT, Windows 2000
begin
// warning! change name for other drives: ex.: second drive ‘\\.\PhysicalDrive1\’
hDevice := CreateFile( ‘\\.\PhysicalDrive0′, GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0 );
end
else // Version Windows 95 OSR2, Windows 98
hDevice := CreateFile( ‘\\.\SMARTVSD’, 0, 0, nil, CREATE_NEW, 0, 0 );
if hDevice=INVALID_HANDLE_VALUE then Exit;
try
FillChar(SCIP,SizeOf(TSendCmdInParams)-1,#0);
FillChar(aIdOutCmd,SizeOf(aIdOutCmd),#0);
cbBytesReturned := 0;
// Set up data structures for IDENTIFY command.
with SCIP do
begin
cBufferSize := IDENTIFY_BUFFER_SIZE;
// bDriveNumber := 0;
with irDriveRegs do
begin
bSectorCountReg := 1;
bSectorNumberReg := 1;
// if Win32Platform=VER_PLATFORM_WIN32_NT then bDriveHeadReg := $A0
// else bDriveHeadReg := $A0 or ((bDriveNum and 1) shl 4);
bDriveHeadReg := $A0;
bCommandReg := $EC;
end;
end;
if not DeviceIoControl( hDevice, $0007c088, @SCIP, SizeOf(TSendCmdInParams)-1,
@aIdOutCmd, SizeOf(aIdOutCmd), cbBytesReturned, nil ) then Exit;
finally
CloseHandle(hDevice);
end;
with PIdSector(@IdOutCmd.bBuffer)^ do
begin
ChangeByteOrder( sSerialNumber, SizeOf(sSerialNumber) );
(PChar(@sSerialNumber)+SizeOf(sSerialNumber))^ := #0;
Result := PChar(@sSerialNumber);
end;
end; ///KULLANIM procedure TForm1.Button4Click(Sender: TObject);
var s : String;
rc : DWORD;
begin
s := GetIdeSerialNumber;
if s=” then
begin
rc := GetLastError;
if rc=0 then label4.caption:=’IDE drive is not support SMART feature’
else label4.caption:=SysErrorMessage(rc);
end
else label4.caption:= s;

end;

Ekranın Görüntüsünü Almak

admin — Mon, 09 Mar 2009 20:52:18 +0000

//Formunuza TImage ekleyin! Yada Ekran Görüntüsü
//Formunuzun Üzerine Almak istiyorsaniz Asagidaki Koddaki
//image1`i Form1 yapin hatirlatmis olayim )

procedure TForm1.Button1Click(Sender: TObject);
var
DCDesk: HDC;
begin
DCDesk:=GetWindowDC(GetDesktopWindow);
BitBlt(Image1.Canvas.Handle, 0, 0, Screen.Width, Screen.Height,DCDesk, 0, 0,SRCCOPY);
ReleaseDC(GetDesktopWindow, DCDesk);
end;

Windows Tarih ve Saat Özellikleri Dialog`unu Açma

admin — Mon, 09 Mar 2009 20:51:49 +0000

Winexec(‘Control.exe Date/Time’,sw_shownormal);

Encrypt / decrypt Nedir

admin — Mon, 09 Mar 2009 20:50:44 +0000

// This example shows how you can encrypt strings
// using special security string.
// You can decode data only if you know security string.
// I suppose, there is no chance to hack security string, using any analyse algorythms.
// Every time you call this function, you will
// have a new result even if all params are constant
// NOTE: Don`t forget to call “Randomize” proc before using this functions.

const
Codes64 = ’0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz+/’;

// you must use this function to generate special
// security string, which is used in main encode/decode routines.
// NOTE: you must generate the security string only once and then use it in encode/decode functions.

function GeneratePWDSecutityString: string;
var
i, x: integer;
s1, s2: string;
begin
s1 := Codes64;
s2 := ”;
for i := 0 to 15 do
begin
x := Random(Length(s1));
x := Length(s1) – x;
s2 := s2 + s1[x];
s1 := Copy(s1, 1,x – 1) + Copy(s1, x + 1,Length(s1));
end;
Result := s2;
end;

// this function generate random string using
// any characters from “CHARS” string and length
// of “COUNT” – it will be used in encode routine
// to add “noise” into your encoded data.

function MakeRNDString(Chars: string; Count: Integer): string;
var
i, x: integer;
begin
Result := ”;
for i := 0 to Count – 1 do
begin
x := Length(chars) – Random(Length(chars));
Result := Result + chars[x];
chars := Copy(chars, 1,x – 1) + Copy(chars, x + 1,Length(chars));
end;
end;

// This will encode your data.
// “SecurityString” must be generated using method
// described above, and then stored anywhere to
// use it in Decode function.
// “Data” is your string (you can use any characters here)
// “MinV” – minimum quantity of “noise” chars before each encoded data char.
// “MaxV” – maximum quantity of “noise” chars before each encoded data char.

function EncodePWDEx(Data, SecurityString: string; MinV: Integer = 0;
MaxV: Integer = 5): string;
var
i, x: integer;
s1, s2, ss: string;
begin
if minV > MaxV then
begin
i := minv;
minv := maxv;
maxv := i;
end;
if MinV < 0 then MinV := 0;
if MaxV > 100 then MaxV := 100;
Result := ”;
if Length(SecurityString) < 16 then Exit;
for i := 1 to Length(SecurityString) do
begin
s1 := Copy(SecurityString, i + 1,Length(securitystring));
if Pos(SecurityString[i], s1) > 0 then Exit;
if Pos(SecurityString[i], Codes64) <= 0 then Exit;
end;
s1 := Codes64;
s2 := '';
for i := 1 to Length(SecurityString) do
begin
x := Pos(SecurityString[i], s1);
if x > 0 then s1 := Copy(s1, 1,x – 1) + Copy(s1, x + 1,Length(s1));
end;
ss := securitystring;
for i := 1 to Length(Data) do
begin
s2 := s2 + ss[Ord(Data[i]) mod 16 + 1];
ss := Copy(ss, Length(ss), 1) + Copy(ss, 1,Length(ss) – 1);
s2 := s2 + ss[Ord(Data[i]) div 16 + 1];
ss := Copy(ss, Length(ss), 1) + Copy(ss, 1,Length(ss) – 1);
end;
Result := MakeRNDString(s1, Random(MaxV – MinV) + minV + 1);
for i := 1 to Length(s2) do Result := Result + s2[i] + MakeRNDString(s1,
Random(MaxV – MinV) + minV);
end;

// This will decode your data, encoded with the function above, using specified “SecurityString”.

function DecodePWDEx(Data, SecurityString: string): string;
var
i, x, x2: integer;
s1, s2, ss: string;
begin
Result := #1;
if Length(SecurityString) < 16 then Exit;
for i := 1 to Length(SecurityString) do
begin
s1 := Copy(SecurityString, i + 1,Length(securitystring));
if Pos(SecurityString[i], s1) > 0 then Exit;
if Pos(SecurityString[i], Codes64) <= 0 then Exit;
end;
s1 := Codes64;
s2 := '';
ss := securitystring;
for i := 1 to Length(Data) do if Pos(Data[i], ss) > 0 then s2 := s2 + Data[i];
Data := s2;
s2 := ”;
if Length(Data) mod 2 <> 0 then Exit;
for i := 0 to Length(Data) div 2 – 1 do
begin
x := Pos(Data[i * 2 + 1], ss) – 1;
if x < 0 then Exit;
ss := Copy(ss, Length(ss), 1) + Copy(ss, 1,Length(ss) – 1);
x2 := Pos(Data[i * 2 + 2], ss) – 1;
if x2 < 0 then Exit;
x := x + x2 * 16;
s2 := s2 + chr(x);
ss := Copy(ss, Length(ss), 1) + Copy(ss, 1,Length(ss) – 1);
end;
Result := s2;
end;

Sayıları binary modunda göstermek

admin — Mon, 09 Mar 2009 20:49:54 +0000

function BinB(b: Byte): string;
var
s: string;
i: word;
begin
s := ”;
for i := 7 downto 0 do
if (b and (1 shl i)) > 0 then
s := s + ’1′
else
s := s + ’0′;
BinB := s;
end;

function BinW(w: Word): string;
var
s: string;
i: word;
begin
s := ”;
for i := 15 downto 0 do
if (w and (1 shl i)) > 0 then
s := s + ’1′
else
s := s + ’0′;
BinW := s;
end;

function BinL(l: Longint): string;
var
HL: HiLo absolute l;
begin
BinL := BinW(HL.HiWord) + BinW(HL.LoWord);
end;

Başlat Menüsü Programlarının Tespit Edilmesi

admin — Mon, 09 Mar 2009 20:49:22 +0000

{Forma bir ListBox, bir Buton, birde DDEClientConv nesnesi ekleyip, Service ve Topic özelligini “Progman” olarak giriniz.}

var
B:Pchar;

procedure TForm1.Button1Click(Sender: TObject);
begin
ListBox1.Items.clear;
B := DDEClientConv1.RequestData(‘Groups’);
ListBox1.Items.SetText(B);
StrDispose(B);
end;

Mouse’un Sağ Tuşunu Kullanmak

admin — Mon, 09 Mar 2009 20:48:51 +0000

//bu örnekte form üzerinde mouse’un sag tusuna basilinca merhaba yazan bir mesaj cikar
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if ssright in shift then begin
MessageDlg(‘Merhaba’, mtInformation, [mbOk], 0);
end;
end;

Windows Acılışı Sırasında Programın Calismasının Sağlanması

admin — Mon, 09 Mar 2009 20:48:05 +0000

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
AppExe :string;
begin
if CheckBox1.Checked=true then begin
with TRegistry.Create do
try
RootKey := HKEY_CURRENT_USER;
if OpenKey (‘\SOFTWARE\Microsoft\Windows\CurrentVersion\Run’, true) then
AppExe:=#34+Application.Exename+#34;
WriteString(‘metin’, AppExe);
finally
end;
end;
//DeleteValue(‘metin’); //=>Programinizi Registry den Silmek icin
end;

Ekran Çözünürlüğünün Değiştirilmesi

admin — Mon, 09 Mar 2009 20:46:56 +0000

// AnaForm üzerine ListBox1 ve Button1 bilesenlerini yerlestiriniz

{Ana formun OnCreate olayi}
procedure TForm1.FormCreate(Sender: TObject);
var
i : Integer;
DevMode : TDevMode;
begin
Button1.Enabled:=False;
i := 0;
while EnumDisplaySettings(nil,i,Devmode) do begin
with Devmode do
ListBox1.Items.Add(Format(‘%dx%d %d Colors’,[dmPelsWidth,dmPelsHeight,1 shl dmBitsperPel]));
Inc(i);
end;
end;

{ListBox1′in Onclick olayi}
procedure TForm1.ListBox1Click(Sender: TObject);
// Listede istenilen cözünürlük degeri secildiginde Button1′de kullanir hale getir
begin
Button1.Enabled := Listbox1.ItemIndex >= 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
// Secilen cözünürlük degerini degerini uygula
var
DevMode : TDevMode;
begin
EnumDisplaySettings(nil,Listbox1.ItemIndex,Devmode);
ChangeDisplaySettings(DevMode,0);
end;

Açık Windows Uygulamalarının Gösterilmesi

admin — Mon, 09 Mar 2009 20:45:55 +0000

//AnaForm üzerine bir ListBox1 ve Button1 ekleyiniz

function EnumWindowsProc(Wnd : HWnd;Form : TForm1) : Boolean;
Export; {$ifdef Win32} StdCall; {$endif}
var
Buffer : Array[0..99] of char;
begin
GetWindowText(Wnd,Buffer,100);
if StrLen(Buffer)
<> 0 then
Form1.ListBox1.Items.Add(StrPas(Buffer));
Result := True;
end;

//kullanimi
procedure TForm1.Button1Click(Sender: TObject);
begin
EnumWindows(@EnumWindowsProc,LongInt(Self));
end;

Verilen web sitesini Internet Explorer’da açmak

admin — Mon, 09 Mar 2009 20:45:19 +0000

procedure TForm1.Button1Click(Sender: TObject);
begin
winexec(‘C:\Program Files\Internet Explorer\iexplore.exe www.delphiturk.com’,SW_MAXIMIZE);

end;

Form üzerinde herhangi bir nesneyi taşımak

admin — Mon, 09 Mar 2009 20:44:41 +0000

Procedure TForm1.Button1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
const
sc_DragMove=$F012;

begin
ReleaseCapture;
Button1.Perform(WM_SYSCOMMAND, sc_DragMove, 0);

end;

BMP’den JPEG’e dönüştürme

admin — Mon, 09 Mar 2009 20:43:51 +0000

uses jpeg;

procedure TForm1.Button1Click(Sender: TObject);
var
bmp : TImage;
jpg : TJpegImage;
begin
bmp := TImage.Create(nil);
jpg := TJpegImage.Create;
bmp.picture.bitmap.LoadFromFile ( ‘c:\picture.bmp’ );
jpg.Assign( bmp.picture.bitmap );
jpg.SaveToFile ( ‘c:\picture.jpg’ );
jpg.Free;
bmp.Free;
end;

Ctrl+Esc ve Alt+Tab Tuşlarını Devre Dışı Bırakmak

admin — Mon, 09 Mar 2009 20:43:23 +0000

Devre Disi Birakmak icin:
var
OldVal : LongInt;
begin
SystemParametersInfo (97, Word (True), @OldVal, 0)
end;

Eski Haline Döndürmek:

var
OldVal : LongInt;
begin
SystemParametersInfo (97, Word (False), @OldVal, 0)
end;

Saati Yok Etmek

admin — Mon, 09 Mar 2009 20:42:44 +0000

Yok etmek icin:

procedure TForm1.Button1Click(Sender: TObject);
var
Wnd : Thandle;
begin
Wnd := FindWindow(‘Shell_TrayWnd’, nil);
Wnd := FindWindowEx(Wnd, HWND(0),’TrayNotifyWnd’, nil);
Wnd := FindWindowEx(Wnd, HWND(0),’TrayClockWClass’, nil);
ShowWindow(Wnd, SW_HIde);
end;

Göstermek icin:

Paradox veya Dbase dosyasının program içinden oluşturulması

admin — Mon, 09 Mar 2009 20:42:17 +0000

Dinamik olarak bir Paradox tablosu nasil olusturulur

Normalde veritabanlarini Database Desktop benzeri arabirimler ile olusturabilirsiniz.
Peki ya veritabanlarini kod ile olusturmaniz gerekirse?
Mesela ayni veritabanindan birden cok olusturmaniz gerektiginde?
Veya programinizin veritabani dosyalari bozuldugunda yenilenmeleri gerektiginde?
Daha bircok durum sözkonusu olabilir.
Asagida 3 basit alana sahip bir paradox veritabanini nasil olusturabileceginizi
görebilirsiniz.

var
Table1 : TTable;
begin
Table1 := TTable.Create(Self);
with Table1 do
begin
DatabaseName := ‘C:\Temp’; { istediginiz dizin }
TableName := ‘KISI’;
TableType := ttParadox;
with FieldDefs do
begin { alanlari belirt }
Add(‘Ad’, ftString, 25, False);
Add(‘Yas’, ftInteger, 0, True);
Add(‘Kilo’, ftFloat, 0, False);
end;
{ primary index’i olustur }
IndexDefs.Add(‘MainIndex’,'IntField’,
[ixPrimary, ixUnique]);
{ table’i fiziksel olarak olustur }
CreateTable;
end;

StringGrid’de Satır silme

admin — Mon, 09 Mar 2009 20:41:34 +0000

procedure GridDeleteRow(RowNumber : Integer; Grid : TStringGrid);
Var
i : Integer;
Begin
Grid.Row := RowNumber;
If (Grid.Row = Grid.RowCount -1) Then
Begin
Grid.RowCount := Grid.RowCount – 1;
End
Else
Begin
For i := RowNumber To Grid.RowCount – 1 Do
Begin
Grid.Rows[i] := Grid.Rows[i+ 1];
End;
Grid.RowCount := Grid.RowCount – 1;
End;
End;

procedure TForm1.Button1Click(Sender: TObject);
begin
GridDeleteRow(3,StringGrid1);
end;

DBGrid’e Kayıt eklemeyi önleme

admin — Mon, 09 Mar 2009 20:41:10 +0000

DBGRID’e kayit eklenmesini önleme

‘DBGRID nesnesi kullandiginizda kullanici en alt satira gelip asagi
oka bastigi gibi yeni bir satir olusturulur ve kullanici bu yolla yeni
bir kayit girebilir. Bazi durumlarda bu sekilde kayitlarin girilmesini istemeyebilirsiniz.
Nesnenizin adinin DBGrid1 oldugunu düsünerek bu nesnenin
OnKeyDown event’ine asagidaki procedure’ü girerek bu istenmeyen durumdan kurtulabilirsiniz.

procedure TForm1.DBGrid1KeyDown(Sender: TObject;
var Key: Word;
Shift: TShiftState);
begin
if (Key = VK_DOWN) then
begin
Table1.DisableControls;
Table1.Next;
if Table1.EOF then Key:= 0
else Table1.Prior;
Table1.EnableControls;
end;
end;

DbGrid’de Enter ile Dolaşmak

admin — Mon, 09 Mar 2009 20:40:37 +0000

procedure TForm1.DBGrid1KeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
if DBGrid1.Columns.Grid.SelectedIndex < DBGrid1.Columns.Count – 1 then
DBGrid1.Columns[DBGrid1.Columns.grid.SelectedIndex + 1].Field.FocusControl
else
begin
Table1.next;
DBGrid1.Columns[0].field.FocusControl;
end;
end;

Key Kodları

admin — Mon, 09 Mar 2009 20:40:06 +0000

{ Virtual Keys, Standard Set }
VK_LBUTTON = 1;
VK_RBUTTON = 2;
VK_CANCEL = 3;
VK_MBUTTON = 4; { NOT contiguous with L & RBUTTON }
VK_BACK = 8;
VK_TAB = 9;
VK_CLEAR = 12;
VK_RETURN = 13;
VK_SHIFT = $10;
VK_CONTROL = 17;
VK_MENU = 18;
VK_PAUSE = 19;
VK_CAPITAL = 20;
VK_KANA = 21;
VK_HANGUL = 21;
VK_JUNJA = 23;
VK_FINAL = 24;
VK_HANJA = 25;
VK_KANJI = 25;
VK_CONVERT = 28;
VK_NONCONVERT = 29;
VK_ACCEPT = 30;
VK_MODECHANGE = 31;
VK_ESCAPE = 27;
VK_SPACE = $20;
VK_PRIOR = 33;
VK_NEXT = 34;
VK_END = 35;
VK_HOME = 36;
VK_LEFT = 37;
VK_UP = 38;
VK_RIGHT = 39;
VK_DOWN = 40;
VK_SELECT = 41;
VK_PRINT = 42;
VK_EXECUTE = 43;
VK_SNAPSHOT = 44;
VK_INSERT = 45;
VK_DELETE = 46;
VK_HELP = 47;
{ VK_0 thru VK_9 are the same as ASCII ’0′ thru ’9′ ($30 – $39) }
{ VK_A thru VK_Z are the same as ASCII ‘A’ thru ‘Z’ ($41 – $5A) }
VK_LWIN = 91;
VK_RWIN = 92;
VK_APPS = 93;
VK_NUMPAD0 = 96;
VK_NUMPAD1 = 97;
VK_NUMPAD2 = 98;
VK_NUMPAD3 = 99;
VK_NUMPAD4 = 100;
VK_NUMPAD5 = 101;
VK_NUMPAD6 = 102;
VK_NUMPAD7 = 103;
VK_NUMPAD8 = 104;
VK_NUMPAD9 = 105;
VK_MULTIPLY = 106;
VK_ADD = 107;
VK_SEPARATOR = 108;
VK_SUBTRACT = 109;
VK_DECIMAL = 110;
VK_DIVIDE = 111;
VK_F1 = 112;
VK_F2 = 113;
VK_F3 = 114;
VK_F4 = 115;
VK_F5 = 116;
VK_F6 = 117;
VK_F7 = 118;
VK_F8 = 119;
VK_F9 = 120;
VK_F10 = 121;
VK_F11 = 122;
VK_F12 = 123;
VK_F13 = 124;
VK_F14 = 125;
VK_F15 = 126;
VK_F16 = 127;
VK_F17 = 128;
VK_F18 = 129;
VK_F19 = 130;
VK_F20 = 131;
VK_F21 = 132;
VK_F22 = 133;
VK_F23 = 134;
VK_F24 = 135;
VK_NUMLOCK = 144;
VK_SCROLL = 145;
{ VK_L & VK_R – left and right Alt, Ctrl and Shift virtual keys.
Used only as parameters to GetAsyncKeyState() and GetKeyState().
No other API or message will distinguish left and right keys in this way. }
VK_LSHIFT = 160;
VK_RSHIFT = 161;
VK_LCONTROL = 162;
VK_RCONTROL = 163;
VK_LMENU = 164;
VK_RMENU = 165;
VK_PROCESSKEY = 229;
VK_ATTN = 246;
VK_CRSEL = 247;
VK_EXSEL = 248;
VK_EREOF = 249;
VK_PLAY = 250;
VK_ZOOM = 251;
VK_NONAME = 252;
VK_PA1 = 253;
VK_OEM_CLEAR = 254;

Programı taskbardan saklamak

admin — Mon, 09 Mar 2009 20:39:33 +0000

procedure TForm1.FormCreate(Sender: TObject);
begin
WS_EX_TOOLWINDOW); //taskbardan saklar
SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
end;

Belgeler Klasörünü temizlemek

admin — Mon, 09 Mar 2009 20:39:07 +0000

Uses ShlOBJ;

procedure TMainForm.ButTemizleClick(Sender: TObject);
begin
SHAddToRecentDocs(SHARD_PATH, nil);
ShowMessage(‘Temizlendi’);
end;

Mouse Tuslarını Değiştirmek

admin — Mon, 09 Mar 2009 20:38:39 +0000

Degistirme
SystemParametersInfo(SPI_SETMOUSEBUTTONSWAP, 1, NIL, 0);
Eski Haline Getirmek
SystemParametersInfo(SPI_SETMOUSEBUTTONSWAP, 0, NIL, 0);

Paradox dosyasına program içerisinden şifre konulması

admin — Mon, 09 Mar 2009 20:38:11 +0000

procedure AddMasterPassword(Table: TTable; pswd: string);

const
RESTRUCTURE_TRUE = WordBool(1);
var
TblDesc: CRTblDesc;
hDb: hDBIDb;
begin
{ Make sure that the table is opened and is exclusive }
if not Table.Active or not Table.Exclusive then
raise EDatabaseError.Create(‘Table must be opened in exclusive ‘ +
‘mode to add passwords’);
{ Initialize the table descriptor }
FillChar(TblDesc, SizeOf(CRTblDesc), #0);
with TblDesc do begin

{ Place the table name in descriptor }
StrPCopy(szTblName, Table.TableName);
{ Place the table type in descriptor }
StrCopy(szTblType, szPARADOX);
{ Master Password, Password }
StrPCopy(szPassword, pswd);
{ Set bProtected to True }
bProtected := RESTRUCTURE_TRUE;
end;
{ Get the database handle from the cursor handle }
Check(DbiGetObjFromObj(hDBIObj(Table.Handle), objDATABASE, hDBIObj(hDb)));
{ Close the table }
Table.Close;

{ Add the master password to the Paradox table }
Check(DbiDoRestructure(hDb, 1, @TblDesc, nil, nil, nil, False));
{ Add the new password to the session }
Session.AddPassword(pswd);
{ Re-Open the table }
Table.Open;
end;

// Kullanimi:
Table1.Close;
Table1.Exclusive := True;
Table1.Open;
AddMasterPassword(Table1, ‘denemesifre’);

Mousun Ekran koordinatlarını değiştirmek

admin — Mon, 09 Mar 2009 20:37:30 +0000

procedure TForm1.Button2Click(Sender: TObject);
begin
//mouse ekran kordinatlarini degistrir
SetCursorPos(11,22);
end;

Yuvarlak Form Oluşturma

admin — Mon, 09 Mar 2009 20:36:58 +0000

procedure TForm1.FormCreate(Sender: TObject);
var
region: HRgn;
begin
{ yuvarlak form olusturur }
region:=CreateEllipticRgn(1,1,200,200);
SetWindowRgn(handle, region, true);
end;

istenen değere göre sayı yuvarlama

admin — Mon, 09 Mar 2009 20:36:29 +0000

function Yuvarla(deger: extended): extended;
var
yeni, kez: integer;
sayi: extended;
sayi2: extended;
const
ikimilyar: extended = 2000000000;
olcu: extended = 1000; //sayiyi 1000′e yuvarlama
begin
if deger <= 2147483647 then
begin
yeni := round(deger);
result := ((yeni div olcu) * olcu) + (byte((yeni MOD olcu)
>= (olcu/2)) * olcu);
end
else
begin
kez := 0;
while deger > MaxInt do
begin
deger := deger – ikimilyar;
inc(kez);
end;
yeni := round(deger);
sayi := ikimilyar * kez;
sayi2 := ((yeni div olcu) * olcu) + (byte((yeni MOD olcu)
>= (olcu/2)) * olcu);
result := sayi + sayi2;
end;
end;

Modemin durumunu kontrol etmek

admin — Mon, 09 Mar 2009 20:35:53 +0000

procedure TForm1.Button1Click(Sender: TObject);
var
CommPort : string;
hCommFile : THandle;
ModemStat : DWord;
begin
CommPort := ‘COM2′;
hCommFile := CreateFile(PChar(CommPort),
GENERIC_READ,
0,
nil,
OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL,
0);
if hCommFile = INVALID_HANDLE_VALUE then
begin
ShowMessage(CommPort+’acilamadi’ );
exit;
end;
if GetCommModemStatus(hCommFile, ModemStat) <> false then begin
if ModemStat and MS_CTS_ON <> 0 then
ShowMessage(‘The CTS (clear-to-send) is on.’);
if ModemStat and MS_DSR_ON <> 0 then
ShowMessage(‘The DSR (data-set-ready) is on.’);
if ModemStat and MS_RING_ON <> 0then
ShowMessage(‘The ring indicator is on.’);
if ModemStat and MS_RLSD_ON <> 0 then
ShowMessage(‘RLSD (receive-line-signal-detect)’);
end;
{Close the comm port}
CloseHandle(hCommFile);
end;

İbrahim Kaypakkaya

admin — Mon, 09 Mar 2009 20:35:52 +0000

İbrahim Kaypakkaya

1949 yılında Çorum Alaca’da doğdu.TKP/ML kurucusu.Hasanoğlan Öğretmen Okulu’nda, Çapa Yüksek Öğretmen Okulu ve İÜ Fen Fakültesi Matematik-Fizik Bölümü’nde okudu.FKF Çapa Şubesi’nin kuruluşuna katıldı.1968 yılında TİP Eminönü ilçe teşkilatına üye oldu.Ant ve Türk Solu dergisi yazı kurulunda bulundu.Amerikan 6.Filosunu protesto eylemlerine katıldı.MDD-SD tartışmalarında önce SD sonra MDD tezini benimsedi.TİP’ten ihraç edildi.Doğu Perinçek liderliğinde bir oluşum olan PDA -TİİKP içinde yer aldı.Bilahare bu hareketten ayrılarak arkadaşlarıyla TKP/ML’yi kurdu.24 Ocak 1973’te Tunceli kırsalında yakalandı.3.5 ay gözaltında kaldı.18 Mayıs 1973’te gözaltındayken öldü.

HAKKINDA YAZILANLAR

1.Kaypakkaya ile Birlikte…
(Anılarla Geçmişe Yolculuk)
Cilt: 1
Ali Taşyapan
Belge Yayınları / Yaşam ve Anılar Dizisi

“Ben anılarımı yazılacak değerde görmüyorum. Fakat bazı devrimci dostlarım bunun karşıtını düşünüyorlar. Bu dostlar, 68 kuşağından, Çapalı ve İbrahim Kaypakkayayı en çok tanıyanlardan biri olmamı, iki cezaevi dönemi yaşamımı ve politik bir geçmişe sahip olmamı çok önemsiyorlar. Yaşadıklarımı, bildiklerimi yazıya dökmeden beraberimde mezara götürür olmama hayıflanıyorlar. Şöyle düşünüyorum: Madem yazmaya, yazıyorum, neden yazım işini yanlız politik geçmişimle sınırlayayım? Yaşamımın diğer dönemlerine neden üvey evlat muamelesi yapayım? O dönemlerin de ilginç görüntüleri var. Okuyucuyu güldüren, düşündüren, üzen, sevindiren, manzaralar elbet bulunur. Hem bu, anı defterine bir çeşni de katar. İşte değerli dostlar, bu yüzden laf torbasının ağzını sonuna kadar açacağım, beceremiyeceğimi bildiğim için edebi bir tarzda yazmaya özenmeyeceğim, çal kalem mektup yazar gibi patır-kütür yazacağım.

2.İbrahim Kaypakkaya
Ser Verip Sır Vermeyen Komünist Önder
Hayatı ve Mücadelesi
Nihat Behram
Umut Yayımcılık / Belgesel – Roman Dizisi

Eğer insanlık, elecete bir komünizm panteonu kurarsa, hiç kuşku yok ki, bu panteonun eskiden adına Türkiye denilen kesiminde, genç ve ateşli bir komünist önderin, bir inanç ve direniş sembolünün, defne çelengi içindeki başına, ışıklandırılmış kasketli başına yer verecektir.

3.Fırtınalı Yıllarda İbrahim Kaypakkaya
“Bilinmeyen” Yazılar
Ethem Direhşan
Belge Yayınları / Yaşam ve Anılar Dizisi

Kaypakkayanın hiç de hak etmediği “ignorasyon”a karşı, hasbel kader katkıda bulunmak amacı ile hazırlanmıştır. Kitabın derleniş amacı, salt bir belgesel olmayı gütmemektedir. Bunun da ötesinde amaç, Kaypakkayanın devrimci mücadeleye “ilk” başlangıcından, öldürüldüğü tarihe kadar kat ettiği güzergah hakkında özellikle, yeni devrimci nesillere bir ipucu vermektir. Dolayısiyle, derlenen yazılar bir anlamda Kaypakkayanın “bilinmeyen” yazılarıdır. 60lı yılları araştırmak, devrimci geçmişimizin güzel ve doğru değerlerini, Solun da “resmi tarih”ine hapis olmadan inceleyip, bulup ortaya çıkartmak biz genç araştırmacıların tutkusudur ve böylede olmalıdır.

Formların maximize ve minimize butonlarına basıldığını anlamak

admin — Mon, 09 Mar 2009 20:35:28 +0000

public
procedure WMSysCommand(var Msg: TWMSysCommand);
message WM_SYSCOMMAND;

…………

procedure TForm1.WMSysCommand;
begin
if (Msg.CmdType = SC_MINIMIZE) or
(Msg.CmdType = SC_MAXIMIZE) then
Showmessage(‘Deneme’);//Burda istediginiz islemi
gerceklestirebilirsiniz
DefaultHandler(Msg);
end;

Hex -> Decimal, Decimal -> Hex çevrimi

admin — Mon, 09 Mar 2009 20:34:50 +0000

// Hex -> Decimal
function ConvertToDecimal(const hexValue: Integer): string;
begin
Result := Format(‘%d’, [hexValue]);
end;

// Decimal -> Hex
function ConvertTohex(const DecimalValue: Integer): string;
begin
Result := Format(‘%x’, [DecimalValue]);
end;

Program içerisinden standart (Paradox, Dbase) alias yaratmak, silmek

admin — Mon, 09 Mar 2009 20:34:19 +0000

// Paradox icin (Tsession Data Access paletinde bulunabilir)
Session1.AddStandardAlias(‘ALIAS_ADI’, ‘c:\data’, ‘paradox’);

// Dbase icin
Session1.AddStandardAlias(‘ALIAS_ADI’, ‘c:\data’, ‘dbase’);

{
Bu islemlerden sonra SaveConfigFile metodunu cagirip
yarattiginiz alias’i kaydetmelisiniz.
}
Session1.SaveConfigFile;

// Alias silmek icin
Session.DeleteAlias(‘ALIAS_ADI’);

StringGrid’de elemanları istenilen yöne dayanmış şekilde yazdırmak

admin — Mon, 09 Mar 2009 20:33:49 +0000

{
Bu islemle ilgili bir ornek program Programlar bolumunde
bulunmaktadir
}

procedure DrawCell(const Value: String; const Rect: TRect;
vCanvas: TCanvas; vFont: TFont; vAlignment: TAlignment);
VAR X : Integer;
BEGIN
vCanvas.Font := vFont;
CASE vAlignment OF
taRightJustify : BEGIN
SetTextAlign(vCanvas.Handle, TA_RIGHT);
X := Rect.Right-2;
END;
taLeftJustify : BEGIN
SetTextAlign(vCanvas.Handle, TA_LEFT);
X := Rect.Left+2;
END;
taCenter : BEGIN
SetTextAlign(vCanvas.Handle, TA_CENTER);
X := (Rect.Right+Rect.Left) DIV 2;
END;
END;
vCanvas.TextRect(Rect, X, Rect.Top+2, Value);
SetTextAlign(vCanvas.Handle, TA_LEFT);
END;

// Kullanimi: (StringGrid1.OnDrawCell event handler’i)

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin
case ACol of
1:
DrawCell((Sender as TStringGrid).Cells[ACol, ARow], Rect, (Sender as TStringGrid).Canvas,
(Sender as TStringGrid).Font, taRightJustify);
2:
DrawCell((Sender as TStringGrid).Cells[ACol, ARow], Rect, (Sender as TStringGrid).Canvas,
(Sender as TStringGrid).Font, taCenter);
3:
DrawCell((Sender as TStringGrid).Cells[ACol, ARow], Rect, (Sender as TStringGrid).Canvas,
(Sender as TStringGrid).Font, taLeftJustify);
else ;
end;
end;

Sistemdeki tarih ayracını almak

admin — Mon, 09 Mar 2009 20:33:01 +0000

uses IniFiles;

function GetDateSeperator: string;
var
IniFile: TIniFile;
begin
IniFile := TIniFile.Create(‘win.ini’);
try
Result := IniFile.ReadString(‘intl’, ‘sDate’, ‘.’);
finally
IniFile.Free;
end;
end;

// Kullanimi:
procedure TForm1.Button1Click(Sender: TObject);
begin
Label1.Caption := GetDateSeperator;
end;

Ekran koruyucuyu program içerisinden cağırmak ve ekran koruyucu devreye girdiğinde haberdar olmak

admin — Mon, 09 Mar 2009 20:32:26 +0000

{
Bazi durumlarda programiniz calisirken ekran koruyucunun devreye
girmesini istemeyebilirsiniz ekran koruyucunun islemci kullanimini
artirmasindan dolayi. Özellikle kullanicinin islem yapmadigi
fakat programin devamli isler yaptigi (Seri Porttan veri transferi vb)
durumlarda faydali olabilir.
}

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics,
Controls, Forms, Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
CheckBox1: TCheckBox;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
procedure WMSysCommand(VAR Msg: TWMSysCommand);
message WM_SYSCOMMAND;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

// Ekran koruyucuyu calistir
procedure TForm1.Button1Click(Sender: TObject);
begin
Perform(WM_SYSCOMMAND, SC_SCREENSAVE, 0);
end;

// Ekran koruyucu devreye girmek uzere
procedure TForm1.WMSysCommand(VAR Msg: TWMSysCommand);
BEGIN
IF (Msg.CmdType AND $FFF0) = SC_SCREENSAVE THEN
IF CheckBox1.Checked THEN
BEGIN
Msg.Result := 0;
Label1.Captiion := ‘Ekran koruyucunun calismasi durduruldu’;
Exit;
END
ELSE Label1.Captiion := ‘Ekran koruyucu calisti’;
Inherited;
END;

Programda menünün aktif olup olmadığını anlamak

admin — Mon, 09 Mar 2009 20:31:35 +0000

const
WM_EXITMENULOOP = $212;
type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
Test1: TMenuItem;
ItemA1: TMenuItem;
ItemB1: TMenuItem;
ItemC1: TMenuItem;
private
{ Private declarations }
procedure WMEnterMenuLoop(VAR Msg: TWMNoParams);
message WM_ENTERMENULOOP;
procedure WMExitMenuLoop(VAR Msg: TWMNoParams);
message WM_EXITMENULOOP;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}
procedure TForm1.WMEnterMenuLoop(VAR Msg: TWMNoParams);
BEGIN
Inherited;
Caption := ‘Menu aktif’;
END;

procedure TForm1.WMExitMenuLoop(VAR Msg: TWMNoParams);
BEGIN
Inherited;
Caption := ‘Menu aktif degil’;
END;

İbni Haldun

admin — Mon, 09 Mar 2009 20:31:01 +0000

İbni Haldun

İBNİ HALDUN KİMDİR?
Ülker Nihal Manaz – Dr Abdullah Manaz

Ünlü İslam Bilgini İbni Haldun, 1332 yılında Tunusta doğdu. Geçmişte birçok önemli devlet ve bilim adamı yetiştirmiş bir aileye mensuptu. Babası değerli bir bilim adamıydı. İbni Haldun küçük yaşlarda eğitime başladı ve Kuran-ı Kerimi ezberledi. 17 yaşında eken babasını kaybetti. İlk bilimsel çalışmalarını hukuk üzerinde yaptı ve bu konuda kendisini iyi yetiştirdi. Daha sonra matematik, edebiyat, mantık, tefsir,hadis ve gramer dallarında öğrenim gördü. Döneminin bilim adamlarından dersler aldı. 20 yaşlarından itibaren devlet idaresinde görevler üstlendi. Tunus emirinin başkatipliğine getirildi. Bu yıllarda, Kuzey Afrikada bulunan İslam ülkeleri arasında siyasi ve fikri mücadeleler vardı. Nitekim bir süre sonra Tunus Hükümdarı bir savaşta öldürüldü. Onun yerine geçen idareciler ise, İbni Halduna karşı cephe aldılar. Bu nedenle İbni Haldun kardeşinin bulunduğu Fasa geçmek zorunda kaldı. Zamanla burada da siyasi kargaşalar başgösterdi. İbni Haldun bir iddia ile hapse atıldı. Fas Sultanının ölümü üzerine hapisten kurtulan İbni Haldun, bu kez de İspanyadaki Beni Ahmer Devletine geçti. İdarecilerin isteği üzerine, Kastilya Kralı Zalim Pedronun yanında elçi olarak görevlendirildi.

Pedro, İbni Haldunun görüşlerine hayran kalmış ve birçok problemlerin çözümünde Ona danışmıştı. Ülkesinde kalması için büyük vaadlerde bulunuyordu. Buna rağmen İbni Haldun burada da fazla kalmadı, yine Fasa döndü. Fakat, siyasi kargaşalar sonucu tekrar hapislere düştü. Büyük sıkıntılar çekti. Çeşitli sebeplerle birkaç İslam ülkesini daha gezdi. Bu arada, salgın bir hastalık yüzünden bütün ailesini kaybetmişti. Ayrıca, yerleşme kararı aldığı Mısıra hanımını, çocuklarını ve mal varlığını getiren gemi batmış, yapayalnız kalmıştı. Bütün bu olaylar hayatının bundan sonraki kısmında İbni Haldunun yalnızlığa çekilmesine neden oldu. Bir ara Mısırda hem hakimlik yaptı hem de medresede dersler verdi. Ancak yine Onu kıskananlar ve görüşlerine tahammül edemeyenler ortaya çıktı. Timur ordularının Mısır ordularını yenmesi üzerine İbni Haldun da esir edildi. Bu olay, İbni Haldunu Timurun karşısına çıkardı. Timur Onun bilgisine ve zekasına hayran oldu. Onunla sohbetler yaptı. Hatta bu karşılaşmanın Timuru istila fikrinden vazgeçirdiği söylendi. İbni Haldun, Timurun parlak vaadlerini bir kenara iterek, tekrar Mısıra geldi ve tamamen uzlete çekildi.
İbni Haldun, Mısırda kaldığı bu dönem içerisinde ünlü eseri Mukaddimeyi kaleme aldı. O güne kadar edindiği fikri, siyasi ve ilmi tecrübesiyle adeta muhteşem denilebilecek bir eser vücuda getirdi. Bu eserinin birinci cildinde; önce tarihi olayları yani geçmişi gözler önüne serdi. İkinci cildinde; sosyal olayları tahlil etti ve İslam toplumunun güncel problemlerini ortaya koydu. Üçüncü cildinde ise; geleceğe ışık tutacak önemli tespitlerde bulundu ve metodlar belirledi. Eserinde daima objektif, realist ve tecrübeci bir hareket tarzını benimsedi. Coğrafi şartlarla sosyal hayatın ilişkisini, cemiyet şekillerini, Din ve Devlet hayatının sınırlarını, şehir ve köy ilişkisini, iktisadi hayatı, bilgi nazariyesini, ilimlerin tasnifini ve edebiyat meselelerini ele aldı. Genel Dünya tarihine yer verirken, özellikle Türk tarihine geniş bir bölüm ayırdı. Bu bölümde : “Bu Türklerin dünyadaki milletlerin en büyüğü olduğunu ve beşer cinsleri arasından onlardan başka ayrıca büyük bir cinsin bulunmadığını bil” diyerek okuyucunun dikkatini çekiyordu.
İslam bilimlerinin bütün dallarından, tabii ve sosyal bilimlere kadar, çağına ulaşan her konuda önemli tahlillerde bulunmuştu. Bu nedenle, Tarih Felsefesinin ve İktisat Biliminin kurucusu olarak kabul edildi. Ayrıca insanlık tarihinin ilk toplum bilimcisi ve sosyoloğu olma özelliğini kazandı. Sosyoloji ilminin birçok temel prensiplerini Batılı bilim adamlarından yüzlerce yıl önce ortaya koydu. Tarih, siyaset teorisi ve sosyal psikoloji alanlarında İtalyan Makyavelliye; Sosyal düzenin genel esaslarında Montesquya; Tarih Felsefesi sahasında Rosseu ve Ouguste Comteye; Devletlerin çöküşü ilkesinde İngiliz Tarihçisi Gibbana; Pedagoji dalında ise William James ve Spencere ışık tutan metodlar belirledi.

İbni Haldun, devlet hayatıyla dini hayatın sınırlarını ortaya koyarken, bir çeşit Laik Devlet sistemini savunmuştu. 1406 yılında ölen İbni Haldunun temel gayesi; İslam Medeniyetinin tarihi ve sosyolojik problemlerine ışık tutmak ve İslam kültürüne yeni bir canlılık kazandırmaktı.

İBN HALDUNA GÖRE DEVLETLERİN YIKILIŞ SEBEPLERİ
Öncelikle şunu belirtmek gerekir ki; İbni Haldunun bu alanda kullandığı temel kavram olan Umran terimi, çeşitli Batılı kaynaklarda bazen Medeniyet bazen de Kültür olarak geçmektedir. Kavram kargaşasına yol açmamak için önce bu kavramı izah etmek gerekir. İbni Haldun Umran terimini, toplumsal hayat ve örgütlenmenin iki aşaması olarak gördüğü Kırsal ve Kentsel hayat için genel olarak kullandığı zaman Kültür, Kent Ümranı şeklinde kullandığında ise Medeniyet anlamı taşımaktadır.

Bütün insan toplulukları Kırsal kültürden Kent kültürüne doğru bir gelişme gösterirler. Kırsal Kültür, kendi içinde 3 alt aşamada oluşur. İlk aşama, insani toplumsal hayat ve örgütlenmenin en ilkel biçimidir, göçebelik ve hayvancılığa dayanır. İkinci aşama, hayvancılık alanının çeşitlendiği yine göçebelik toplumudur. Üçüncü son aşama ise, küçük yerleşim birimlerinde (köy veya kasaba) sebze ve tahıl tarımının yapıldığı yerleşik hayatın oluştuğu dönemdir.

İbni Halduna göre; daha kalabalık halk topluluklarını bir arada toplayan Kent hayatı medeniyetin ilk aşamasıdır. Burada hayvancılık ve tarımın yerini Sanayi ve Ticaret almıştır. Esasen, Kırsal alandaki üretim artışı, yeni ihtiyaçların belirmesine ve üretimin pazarlanması ihtiyacına yol açtığı için Kent hayatını ortaya çıkarmıştır. Kent hayatının sürekliliği ve varlığı için, insanların bir araya gelip üretim ve pazarlamada işbirliği yapmaya karar vermesi yeterli değildir. Bunları bir arada tutacak, birbirlerine zarar vermelerini önleyecek bir Egemenlik ve Siyasi Varlık yani Devlet olmak zorundadır. İbni Halduna göre; şehirleşme devleti değil, devlet şehirleşmeyi yaratır. Devlet olmadığı sürece Kentleşme de olmaz. Devletin varlığı ile Kent hayatı özdeşleşir. Kent hayatında ekonomik faaliyetlerin bozulması ile devletin çözülmesi birbiriyle doğrudan ilişkilidir. Her türlü ekonomik faaliyetin hedefi kazanç elde etmektir. Devletin ekonomik hayata adaletsiz müdahalesi, yüksek vergilerle kazancını artırmaya çalışması, mal ve paraya istediği gibi egemen olması, ekonomik hayatı felce uğratır.

İbni Haldun, siyasi bir egemenliğin oluşması, gelişmesi ve çözülmesi sürecinde Siyasi Lider veya liderlerden ziyade grubunun önemli olduğuna inanır. Siyasi bir liderin kişisel özellikleri ne kadar gelişmiş olursa olsun ekibini oluşturamadığı sürece kesin olarak başarıya ulaşamaz. Aynı şekilde, devletlerin çözülme sebeplerini Yönetenlerin kişisel kusurlarında aramak da yanlıştır. Bu görüşüyle İbni Halduna göre Devlet -siyasi- bir Hanedan niteliğindedir. Bir devletin ortaya çıkması, gelişmesi ve en yüksek noktaya ulaştıktan sonra çözülmesiyle bir siyasi hanedanın ortaya çıkması, gelişmesi, yükselmesi ve çözülmesi arasında sıkı bir paralellik kurar. Her devlete ortalama olarak 120 – 130 yıllık bir ömür tanır. Her devlet genel olarak 5 temel aşamadan geçer.
Kuruluş Devresi: Her türlü karşı koymanın bastırıldığı, daha önce onu elinde tutan hanedandan zorla alınması devresidir. Ele geçiren grupta canlılık ve etkinlik en üst düzeydedir. Henüz geleneksel alışkanlıklarını yitirmemiş, mütevazi ve kanaatkardır. Siyasi lider henüz kendisini vatandaşlarından ayrı tutmaz.

Otorite Devresi: İktidarı elinde tutan lider kendi grubu üzerinde otoritesini tesis eder, mülkü ve nimetlerini kendisi için istemeye başlar. Grupta rakip olacak ileri gelenler yönetimden uzaklaştırılır, kendine bağlı itaatkar kişiler yönetime gelir.
Rahatlık Devresi: İktidarın meyveleri toplanır, servet genişletilir, şan ve şöhret ön plana geçer, kendini ölümsüzleştirecek eserler meydana getirilir. Siyasi liderin hem kendi grubunu hem de diğer grupları tam egemenlik altına aldığı dönemdir. Güçlü ordu, iyi çalışan sivil bürokrasi ve düzenli toplanan vergiler vardır.

Taklit Devresi: Siyasi iktidar, atalarının bıraktıklarını yeterli görmeye başlar. En doğru yolun kendisine miras bırakılan yolu takip etmek olduğuna inanır. Taklitçilik ve gelenekçilik, yenileşmenin önünü tıkar.
Savurganlık Devresi: Siyasi iktidar, atalarından kalan mirası arzu ve hevesine göre israf etmeye ve savurganlık yapmaya başlar. Devlet yönetimine ehliyetsiz kişiler geçirilir. Devletin çözülme ve yıkılma süreci başlar. Ordusunu, memurunu besleyemez ve giderlerini karşılayamaz hale gelir ve yıkılır.

İbni Haldun, devletin çözülmesinde dış faktörlerden ziyade iç etkenlerin öncelik taşıdığını kabul eder. Bununla birlikte devletin tümüyle ortadan kalkışı bir dış saldırıyla gerçekleşir. Devletin yıkılışındaki en temel sebepleri; Lider, Ekonomi ve Ahlak olmak üzere 3 temel başlık altında ifade eder.

Lider; devletin kurulma saflasında grubuyla ahlaki bir otorite ilişkisi içindedir. Zamanla otoritesini paylaşmak istemez. Liderin kibir, bencillik ve başkalarına hakim olma duygusu öne geçer. Ona göre siyasetin kendisi de Tek Bir Hakim olmayı gerektirir.
Ekonomi; güç olarak iki temele dayanır : Asker ve Para. Devletin kuruluş safhasında fazla paraya ihtiyaç olmaz. Devlet büyüyüp geliştikçe yeni ihtiyaçlar paraya olan ihtiyacı da ortaya çıkarır. Koruyucu sınıfı ile yönetim arasında ücretlerin ve ihtiyaçların karşılanmasına paralel bir hoşnutluk ilkesi vardır. Yönetimin tek para kaynagı vergilerdir. Vergilerin akması içinse sağlam ve gelişen bir ekonomik yapı gerekir. İbni Haldun, ekonominin kendine has kanunları olduğunu belirtir ve herhangi bir zorlama ekonomik hayatı alt-üst eder. Ekonomik gelişmenin bir üst sınırı vardır ve ondan sonra duraklama ve gerileme başlar. Tahrik edilen insani ihtiyaçların artma hızı, bunları karşılayacak kazanç ve gelirlerin artış hızından fazla olduğu için bir noktada yetersizlik başlar. Bu noktada Devlet, ya giderlerini kısmak ya da gelirlerini artırmak şeklinde iki yoldan birini kullanmak durumundadır. Ne yazık ki bu noktadan sonra bu iki yol da başarıya ulaşamaz. Rahatlığa alışmış olanlar kemer sıkamazlar. Devlet gelirleri artırmak için ya varolan vergileri artırır ya da yeni vergiler koymak isteyebilir. Oysa Vergi ile Kazanç arasında tecavüz edilmemesi gereken sınır aşılırsa teşebbüs arzusu zayıflar. Vergide de gelir sağlayamayan Devlet, bu defa ekonomik hayata girmek ister. Üreticilerden mallarını değerlerinin altında almaya, tüketiciye fahiş karla satmaya çalışır. Bunun sonucu üretici üretimden, tüccar ticaretten vazgeçer. Tüketiciler şehirden kaçış yolları arar. Devlet bunun da fayda etmediğini görünce, önce yakınındaki varlıklı kişilerden başlayarak herkesin malına ve mülküne el koyar. Bu da vatandaşların yönetimden yüz çevirmesine, dış güçlerle ittifak yapılmasına, ekonomik hayatın durmasına ve devletin ortadan kalkmasına yol açar.

Ahlak; ilkesinin uygarlığın -ilimlerin, sanatların, şehir hayatının, zenginliğin, konforun, ince alışkanlıkların- gelişmesine paralel olarak bozulup bozulmadığı tarih boyunca tartışma konusu olmuştur. Eski Atinadan başlayarak Rönesansa kadar pek çok düşünür, ahlaki yozlaşmanın bir devletin çöküşünde önemli bir etken olduğunu savunur. Berkeley; “Büyük Britanyanın çöküşünü önlemek üzerine yazdığı düşüncelerinde, İngiliz halkının madddi heveslerinin artışından ve ahlaki niteliklerini kaybedişinden önemle bahseder. Kurtulmak için Hristiyan ahlakının ilkelerinin yeniden saygınlığa kavuşturulması gerektiğini belirtir.” Aynı şekilde Fransada J.J. Rousseau; “Uygarlığın gelişmesinin ahlakın bozulmasına yol açtığını” savunur. Spengler; “Batının çöküşünü konu ettiği eserinde gelişmeyle birlikte ahlaki değer ve kurumların yozlaşmasından” söz eder. Örneğin; Yürek dili yerine, ilmi dinsizlik; Saygı ve gelenek yerine, soğuk olgusallık; Halk yerine, kitlesellik; Gerçek ve canlı değerler yerine, para ve soyut değerler; Devlet ve Toplum yerine, milletlerarası toplum değerleri hakim olur. İnsanlar; kanaatkar, dayanıklı, kendine güvenen, cesur, yardımserver, namuslu, dindar olmak yerine, haris, mağrur, korkak, tembel, bencil, müsrif, rahatına düşkün, dini değerlere lakayt hale gelirler. Doymak bilmeyen ihtiyaçlarını meşru yollardan tatmin edemeyenler, gayrı meşru yolları zorlar ve ahlaki değerleri yıkarlar.
Çözülme sürecinde Devlet bütün vatandaşlarına karşı adil değildir. Halk bireyselleşmiş, gayrı meşru ilişkiler yaygınlaşmış, din ve ahlak duyguları zayıflamıştır

Paradox veya DBase tablosunu Pack etmek (Daha etkili ve güvenli bir yol)

admin — Mon, 09 Mar 2009 20:30:52 +0000

{
Bu ornegi Borland’in Online BDE Reference Yardim dosyasinda
buldum. Gerek Paradox, gerekse Dbase icin problemsiz calisiyor.
Oncelikle tablonun exclusive (sadece bir kisinin acma izninin olmasi) sekilde acilmasi gerekli. Programlar bolumunde
bununla ilgili bir ornek program da bulabilirsiniz.
}

uses BDE;

procedure PackTable(Table: TTable);
var
Props: CURProps;
hDb: hDBIDb;
TableDesc: CRTblDesc;
begin
// Make sure the table is open exclusively so we can get the db handle…
if not Table.Active then
raise EDatabaseError.Create(‘Table must be opened to pack’);
if not Table.Exclusive then

raise EDatabaseError.Create(‘Table must be opened exclusively to pack’);

// Get the table properties to determine table type…
Check(DbiGetCursorProps(Table.Handle, Props));

// If the table is a Paradox table, you must call DbiDoRestructure…
if (Props.szTableType = szPARADOX) then begin
// Blank out the structure…
FillChar(TableDesc, sizeof(TableDesc), 0);
// Get the database handle from the table’s cursor handle…

Check(DbiGetObjFromObj(hDBIObj(Table.Handle), objDATABASE, hDBIObj(hDb)));
// Put the table name in the table descriptor…
StrPCopy(TableDesc.szTblName, Table.TableName);
// Put the table type in the table descriptor…
StrPCopy(TableDesc.szTblType, Props.szTableType);
// Set the Pack option in the table descriptor to TRUE…
TableDesc.bPack := True;
// Close the table so the restructure can complete…
Table.Close;
// Call DbiDoRestructure…

Check(DbiDoRestructure(hDb, 1, @TableDesc, nil, nil, nil, False));
end
else
// If the table is a dBASE table, simply call DbiPackTable…
if (Props.szTableType = szDBASE) then
Check(DbiPackTable(Table.DBHandle, Table.Handle, nil, szDBASE, True))
else
// Pack only works on PAradox or dBASE; nothing else…
raise EDatabaseError.Create(‘Table must be either of Paradox or dBASE ‘ +

‘type to pack’);

Table.Open;

end;

// Kullanimi:
procedure TForm1.Button1Click(Sender: TObject);
begin
Table1.Close;
Table1.Exclusive := True;
Table1.Open;
PackTable(Table1);
end;

Text’i saga, sola ve ortaya gelecek şekilde formatlı şekilde yazmak

admin — Mon, 09 Mar 2009 20:30:00 +0000

{
Bit metin dosyasina verileri yazarken bu verileri formatlamak gerekir. Ornegin bir alan icin 10 karakterlik yer ayrilmissa ve bu alanda bulunan veri 3 karakterse kalanlari bosluk karakteri ile doldurmak gerekir. Ayrica verinin uzunlugu max karakterden fazla ise belli bir yerden sonra kesmek dogru olacaktir. Asagidaki fonksiyonu bu amac icin kullanabilirsiniz.
Ornegi inceleyiniz.
}

procedure CreateFmtBuffer(Buffer: PChar; const S: string; Ch: Char; MaxWidth: Integer; Align: TAlignment);
var L, J, K: Integer;
Len: Integer;
begin
Len := Length(S);
if Len > MaxWidth then Align := taLeftJustify;
L := 0;
case Align of
taLeftJustify:
begin
L := 0;
end;
taRightJustify:
begin
L := MaxWidth – Len;
end;
taCenter:
begin
L := (MaxWidth – Len) div 2;
end;
end;
Len := Len – 1;
for J := 0 to L – 1 do Buffer[J] := Ch;
for K := 0 to Len do Buffer[L + K] := S[K + 1];
K := L + Len + 1;
for J := K to MaxWidth – 1 do Buffer[J] := Ch;
Buffer[MaxWidth] := #0;
end;

function CreateFmtStr(const S: string; Ch: Char; MaxWidth: Integer; Align: TAlignment): string;
var Buffer: PChar;
begin
Buffer := StrAlloc(MaxWidth + 5);
CreateFmtBuffer(Buffer, S, Ch, MaxWidth, Align);
Result := StrPas(Buffer);
StrDispose(Buffer);
end;

// Kullanimi:
Edit1.Text := CreateFmtStr(‘ali’, ‘#’, 10, taRightJustify);
// Sonuc: #######ali

Edit1.Text := CreateFmtStr(‘ali’, ‘#’, 10, taCenter);
// Sonuc: ###ali####

Edit1.Text := CreateFmtStr(‘ali’, ‘#’, 10, taLeftJustify);
// Sonuc: ali#######

Edit1.Text := CreateFmtStr(‘uzunvebuyukveri’, ‘#’, 10, taLeftJustify);
// Sonuc: uzunvebuyu

Edit1.Text := CreateFmtStr(‘ali’, ‘ ‘, 10, taRightJustify);
// Sonuc: ali

Aktif İnternet Explorer penceresindeki adres bilgisinin alınması

admin — Mon, 09 Mar 2009 20:29:03 +0000

function GetText(WindowHandle: hwnd):string;
var
txtLength : integer;
buffer: string;
begin
TxtLength := SendMessage(WindowHandle, WM_GETTEXTLENGTH, 0, 0);
txtlength := txtlength + 1;
setlength (buffer, txtlength);
sendmessage (WindowHandle,wm_gettext, txtlength, longint(@buffer[1]));
result := buffer;
end;

function GetURLFromIntExplorer:string;
var
ie,toolbar,combo,comboboxex,edit,worker,toolbarwindow:hwnd;
url:string;
begin
ie := FindWindow(pchar(‘IEFrame’),nil);
worker := FindWindowEx(ie,0,’WorkerA’,nil);
toolbar := FindWindowEx(worker,0,’rebarwindow32′,nil);
comboboxex := FindWindowEx(toolbar, 0, ‘comboboxex32′, nil);
combo := FindWindowEx(comboboxex,0,’ComboBox’,nil);
edit := FindWindowEx(combo,0,’Edit’,nil);
toolbarwindow := FindWindowEx(comboboxex, 0, ‘toolbarwindow32′, nil);
url := gettext(edit);
result := url;
end;

// Kullanimi:
procedure TForm1.Button1Click(Sender: TObject);
begin
Edit1.Text := GetURLFromIntExplorer;
end;

Genelbilge.com | nedir, tanımı, anlamı,nasıl yapılır » Delphi

Performance Optimization

Behavior

Ağ sürücülerinin Tespiti

Tablodan dosyaya aktarma

Aranan alan tabloda var mı?

Bir tablo alanındaki değerlerin sağ tarafındaki boşlukların temizlenmesi

Tablo yapıları aynı mı?

Tablo adının değiştirilmesi

Tablonun anahtar alanların tespiti

Tabloda Alan tiplerinin bulunması

Tabloda Alan uzunluğunun bulunması

Tabloda Alan numarasının bulunması

Tabloda Alan adının bulunması

Herhangi Bir veritabanından Tablo silme

Bir dBase (.DBF) tablosundaki silinmiş kayıtların görüntülenmesi

dBase tablolarından silinmiş kayıtların atılması

Tablo içeriğinin TstrinGrid bileşenine doldurulması

Detayı olan bir tablodan kayıt silme

Mevcut tablodaki kolonların elenmesi

DBMemo içerisinde bir metnin aranması

Yıldız (*****) Şifrelerinin Gösterilmesi

Binary To Decimal Çevrimi

Decimal To Binary Çevirimi

Program calışırken veri tabanı oluşturulması

Paradox ve Dbase Veri Dosyalarının Pack Yapılması ve İndex hatalarının düzeltilmesi

Bir Stringin Şifrelenmesi ve bu şifrenin çözülmesi

Kullanılan 16 bitlik bir DLL in hafızadan kaldırılması

Şifreleme mantığının kırılması

Formu İstenilen bir Objeden Sürüklemek

Paradox Şifrenizi unuttuysanız asağıdaki şifrelerle veri tabanını açabilirsiniz …

Birebir Veritabanları arasında Tablo ve veya Query Kopyalanması

TablodanKullancı Adı ve Pasword Okumak ve Erişime İzin Vermek

Bilgisayarda Yazıcı yüklümü değil mi ?

Win32 altında Telefon açtırmak

EkranKartının ve Diskin Fabrika seri Numarasının Alınması Pascal 7.0 için

Cep Telefonları için Genel AT Komutları

Form içerisinde hareket

Kullanilan Com Portları bulma.

Delphi İle SMS Yollama

AnsiUpperCase Veya AnsiLoverCase uygulamasına örnek

Ayrı bir dosya (program) nasıl calıştırılır? print edilir?

Excel kayıt boyunu tespit etmek

Ide’de Servers bölümünde WordApplicationla dosya açma

Listbox bileşenlerinde renkli satırlar

Formun caption alanına buton eklemek

Masaüstündeki ikonların gizlenmesi

Edit bileşeninde sadece sayı yazmak

Çalışma Esnasında Program İçerisinden Bileşen Yaratma…

İşletim sistemi tipinin alınmasi (Windows 95, NT)

Harici bir ortamdan basılan tusu anlamak Keyboard Hook

Şifre programı db ve özzelikle veri tabanları için güzel bir program

.avi Dosyalarını Fullscreen oynatma( aviden başka da olabilir)

Programın aynı anda sadece bir kez calışması

Popup Menüyü Kod İle Gösterme 2 Mouse’un bulunduğu pozisyonun alıması

Popup Menüyü Kod İle Gösterme

VeriTabanından Excele Aktarım

Programdan çıkarken bitirme diyaloğu için faydalı bir fonksiyon

IF Sart THEN Bilgi:=’Bilgi-1 ELSE Bilgi:=’Bilgi-2′; şart cümleleri icin kısa bir yol

Ini-Dosyasının yapılan yazılı işlemlerden sonra hemen tazelenmesi

Program içinden herhangi bir tusa basıldığında TAB-tusuna basılmış gibi davranması

internet bağlantı tipinin bulunması

Hdd seri(fabrika) numarası alınması

Ekranın Görüntüsünü Almak

Windows Tarih ve Saat Özellikleri Dialog`unu Açma

Encrypt / decrypt Nedir

Sayıları binary modunda göstermek

Başlat Menüsü Programlarının Tespit Edilmesi

Mouse’un Sağ Tuşunu Kullanmak

Windows Acılışı Sırasında Programın Calismasının Sağlanması

Ekran Çözünürlüğünün Değiştirilmesi

Açık Windows Uygulamalarının Gösterilmesi

Verilen web sitesini Internet Explorer’da açmak

Form üzerinde herhangi bir nesneyi taşımak

BMP’den JPEG’e dönüştürme

Ctrl+Esc ve Alt+Tab Tuşlarını Devre Dışı Bırakmak

Saati Yok Etmek

Paradox veya Dbase dosyasının program içinden oluşturulması

StringGrid’de Satır silme

DBGrid’e Kayıt eklemeyi önleme