Programlama yapalım ve Öğrenelim.

Uygulamanızın Görev Çubuğundaki butonunu gizleme

Uygulamanızın Görev Çubuğundaki butonunu gizleme

Uygulamanızın Görev Çubuğundaki butonunu gizlemek için programınızın ana

formunun OnCreate olayına aşağıdaki kodu yazın;

SetWindowLong(Application.Handle,GWL_EXSTYLE, WS_EX_TOOLWINDOW);

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

Delphi de dosya kopyalama

Windows Api' leri İle Dosya Kopyalama

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

Bilindiği üzere eski pascal'cılar hemen bir dosya mantığı kullanarak dosya kopyalama yoluna girerler gayette güzel olur ama biraz daha derine inmek gerekirse yani kullanıcı tarafından açık olan bir dosyayı kopyalamak istenirse eğer aşağıdaki (Klasik Pascal Kopya) kodu bir işe yaramaz bura da Windows' un Api 'lerine ihtiyaç duyarız.

Birinci Yol

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

Kalıp :

BOOL CopyFile(

LPCTSTR lpExistingFileName, // Kaynak Dosya

LPCTSTR lpNewFileName, //Hedef Dosya

BOOL bFailIfExists // Dosyanın Var olup Olmadığı ve ne yapması Gerektiği True/False );

Ör :

Result:=CopyFile(PChar(SrcTableName),PChar(DestName),True);

Bu Kopyalama işlemi Çok hızlı olup Dosyanın aktif veya pasif olması önemli değil kopyalar.

İkinci Yol

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

Bu işlem Windows'un standart Kopya işlemini yapar.

SehellApi Dosyasında Detaylı bir şekilde görebilirsiniz.

Kalıp :

TSHFileOpStructW = packed record

Wnd: HWND; //Aktif Window Handle

wFunc: UINT; // Yapılacak İşlem Koya,Silme vs..

pFrom: PWideChar; // Kaynak Dosya

pTo: PWideChar; // Hedef Dosya

fFlags: FILEOP_FLAGS; // Default 0

fAnyOperationsAborted: BOOL; // Olayı İptal Etmek yada Etmemek

hNameMappings: Pointer;

lpszProgressTitle: PWideChar; //Pencere Başlığı

end;

Ör :

Var FO : TSHFileOpStruct;

Aborted : Boolean;

With Fo Do

Begin

Wnd:=Handle;

WFunc:=FO_COPY;

PFrom:=pchar(St1.Cells[0,F]);

pTo:=pchar(St1.Cells[1,F]);

FFlags:=0;

fAnyOperationsAborted:=Aborted;

End;

try

SHFileOperation(FO);

finally

end;

Klasik Pascal Dosya Kopyalaması

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

AssignFile(FromF, OpenDialog1.FileName);

Reset(FromF, 1); { Record size = 1 }

if SaveDialog1.Execute then { Display Save dialog box}

begin

AssignFile(ToF, SaveDialog1.FileName); { Open output file }

Rewrite(ToF, 1); { Record size = 1 }

Canvas.TextOut(10, 10, 'Copying ' + IntToStr(FileSize(FromF))

+ ' bytes...');

repeat

BlockRead(FromF, Buf, SizeOf(Buf), NumRead);

BlockWrite(ToF, Buf, NumRead, NumWritten);

until (NumRead = 0) or (NumWritten NumRead);

CloseFile(FromF);

CloseFile(ToF);

end;

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

Delphi de dosya kopyalama

Windows Api' leri İle Dosya Kopyalama

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

Birinci Yol

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

Kalıp :

BOOL CopyFile(

LPCTSTR lpExistingFileName, // Kaynak Dosya

LPCTSTR lpNewFileName, //Hedef Dosya

BOOL bFailIfExists // Dosyanın Var olup Olmadığı ve ne yapması Gerektiği True/False );

Ör :

Result:=CopyFile(PChar(SrcTableName),PChar(DestName),True);

Bu Kopyalama işlemi Çok hızlı olup Dosyanın aktif veya pasif olması önemli değil kopyalar.

İkinci Yol

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

Bu işlem Windows'un standart Kopya işlemini yapar.

SehellApi Dosyasında Detaylı bir şekilde görebilirsiniz.

Kalıp :

TSHFileOpStructW = packed record

Wnd: HWND; //Aktif Window Handle

wFunc: UINT; // Yapılacak İşlem Koya,Silme vs..

pFrom: PWideChar; // Kaynak Dosya

pTo: PWideChar; // Hedef Dosya

fFlags: FILEOP_FLAGS; // Default 0

fAnyOperationsAborted: BOOL; // Olayı İptal Etmek yada Etmemek

hNameMappings: Pointer;

lpszProgressTitle: PWideChar; //Pencere Başlığı

end;

Ör :

Var FO : TSHFileOpStruct;

Aborted : Boolean;

With Fo Do

Begin

Wnd:=Handle;

WFunc:=FO_COPY;

PFrom:=pchar(St1.Cells[0,F]);

pTo:=pchar(St1.Cells[1,F]);

FFlags:=0;

fAnyOperationsAborted:=Aborted;

End;

try

SHFileOperation(FO);

finally

end;

Klasik Pascal Dosya Kopyalaması

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

AssignFile(FromF, OpenDialog1.FileName);

Reset(FromF, 1); { Record size = 1 }

if SaveDialog1.Execute then { Display Save dialog box}

begin

AssignFile(ToF, SaveDialog1.FileName); { Open output file }

Rewrite(ToF, 1); { Record size = 1 }

Canvas.TextOut(10, 10, 'Copying ' + IntToStr(FileSize(FromF))

+ ' bytes...');

repeat

BlockRead(FromF, Buf, SizeOf(Buf), NumRead);

BlockWrite(ToF, Buf, NumRead, NumWritten);

until (NumRead = 0) or (NumWritten NumRead);

CloseFile(FromF);

CloseFile(ToF);

end;

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

Programınızı CTRL+ALt+DEL Çalışan Programlar Menüsünden Gizlemek için

Programınızı CTRL+ALt+DEL

Buyrun Arkadaşlar

SetWindowLong(Application.Handle,GWL_HWNDPARENT,WS_EX_TOOLWINDOW);

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

Programınızı CTRL+ALt+DEL Çalışan Programlar Menüsünden Gizlemek için

Programınızı CTRL+ALt+DEL

Buyrun Arkadaşlar

SetWindowLong(Application.Handle,GWL_HWNDPARENT,WS_EX_TOOLWINDOW);

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

Windows her açıldığında otomatik olarak programın çalışmasını istiyorsanız

Aşğıda örnek kpd ile programanızı windows her açlıdığı zaman aktfi

hale gelemesini sağlayabilirsiniz.

uses kısmına Registry unitini ekleyin.

{$IFNDEF WIN32}

const MAX_PATH = 144;

{$ENDIF}

procedure TForm1.Button1Click(Sender: TObject);

var

reg: TRegistry;

begin

reg := TRegistry.Create;

reg.RootKey := HKEY_LOCAL_MACHINE;

reg.LazyWrite := false;

reg.OpenKey('SoftwareMicrosoftWindowsCurrentVersionRun',false);

reg.WriteString('Uygulamam', uygulamanızın_yolu_ve_adı);

reg.CloseKey;

reg.free;

end;

alıntıdır.

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

Windows her açıldığında otomatik olarak programın çalışmasını istiyorsanız

Aşğıda örnek kpd ile programanızı windows her açlıdığı zaman aktfi

hale gelemesini sağlayabilirsiniz.

uses kısmına Registry unitini ekleyin.

{$IFNDEF WIN32}

const MAX_PATH = 144;

{$ENDIF}

procedure TForm1.Button1Click(Sender: TObject);

var

reg: TRegistry;

begin

reg := TRegistry.Create;

reg.RootKey := HKEY_LOCAL_MACHINE;

reg.LazyWrite := false;

reg.OpenKey('SoftwareMicrosoftWindowsCurrentVersionRun',false);

reg.WriteString('Uygulamam', uygulamanızın_yolu_ve_adı);

reg.CloseKey;

reg.free;

end;

alıntıdır.

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

sıralama

procedure TYayinlar.Button1Click(Sender: TObject);

begin

if Edit1.Text <> '' then begin

CASE RadioGroup1.ItemIndex of

0: begin

DataModule1 .ADODataSet2.Filtered := TRUE;

DataModule1 .ADODataSet2.Filter :='Yayin_adi LIKE %' +

Edit1.Text + '%';

end;

1: begin

DataModule1.ADODataSet2.Filtered := TRUE;

DataModule1 .ADODataSet2.Filter :='Yayin_turu LIKE %' + Edit1.Text + '%';

end;

2: begin

DataModule1.ADODataSet2.Filtered:=True;

DataModule1 .ADODataSet2.Filter :='Yazar_adi LIKE %' + Edit1.Text + '%';

end;

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

sıralama

procedure TYayinlar.Button1Click(Sender: TObject);

begin

if Edit1.Text <> '' then begin

CASE RadioGroup1.ItemIndex of

0: begin

DataModule1 .ADODataSet2.Filtered := TRUE;

DataModule1 .ADODataSet2.Filter :='Yayin_adi LIKE %' +

Edit1.Text + '%';

end;

1: begin

DataModule1.ADODataSet2.Filtered := TRUE;

DataModule1 .ADODataSet2.Filter :='Yayin_turu LIKE %' + Edit1.Text + '%';

end;

2: begin

DataModule1.ADODataSet2.Filtered:=True;

DataModule1 .ADODataSet2.Filter :='Yazar_adi LIKE %' + Edit1.Text + '%';

end;

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

Programınız windows her açıldığında başlasın

Aşğıda örnek kpd ile programanızı windows her açlıdığı zaman aktfi hale

gelemesini sağlayabilirsiniz.

uses kısmına Registry unitini ekleyin.

{$IFNDEF WIN32}

const MAX_PATH = 144;

{$ENDIF}

procedure TForm1.Button1Click(Sender: TObject);

var

reg: TRegistry;

begin

reg := TRegistry.Create;

reg.RootKey := HKEY_LOCAL_MACHINE;

reg.LazyWrite := false;

reg.OpenKey('SoftwareMicrosoftWindowsCurrentVersionRun',false);

reg.WriteString('Uygulamam', uygulamanızın_yolu_ve_adı);

reg.CloseKey;

reg.free;

end;

alıntıdır.

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

Programınız windows her açıldığında başlasın

Aşğıda örnek kpd ile programanızı windows her açlıdığı zaman aktfi hale

gelemesini sağlayabilirsiniz.

uses kısmına Registry unitini ekleyin.

{$IFNDEF WIN32}

const MAX_PATH = 144;

{$ENDIF}

procedure TForm1.Button1Click(Sender: TObject);

var

reg: TRegistry;

begin

reg := TRegistry.Create;

reg.RootKey := HKEY_LOCAL_MACHINE;

reg.LazyWrite := false;

reg.OpenKey('SoftwareMicrosoftWindowsCurrentVersionRun',false);

reg.WriteString('Uygulamam', uygulamanızın_yolu_ve_adı);

reg.CloseKey;

reg.free;

end;

alıntıdır.

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

netteki db ye erisim

arkadaslar buraya soru yazilmaz ama cok acil o yuzden ozur dilerim..

problemim ise net uzerinde ornegin www.abidik.com diye bir web sitem var

bu sitede forum var bu forumun kayitli oldugu veritabanina

yazdigim programla erismek istiyorum...

Ancak problemim burada... veritabani programin calisacagi bir makinede ise

sorun olmadan erisim gerceklesiyor... ama nette iken serverda bulunan veritabanina nasil erisim

gerceklesir?

NOT: veritabani access olacak...!

SAYGILAR

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

netteki db ye erisim

arkadaslar buraya soru yazilmaz ama cok acil o yuzden ozur dilerim..

problemim ise net uzerinde ornegin www.abidik.com diye bir web sitem var

bu sitede forum var bu forumun kayitli oldugu veritabanina

yazdigim programla erismek istiyorum...

Ancak problemim burada... veritabani programin calisacagi bir makinede ise

sorun olmadan erisim gerceklesiyor... ama nette iken serverda bulunan veritabanina nasil erisim

gerceklesir?

NOT: veritabani access olacak...!

SAYGILAR

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

XP de ctrl+alt+del kombinasyonuyla programın sonlandırılmasını önleme

//forma bir adet timer koyun ontimer eventine ctrlaltdel yazın,programı çalıştırın

//ctrl+alt+del kombinasyonunu kullanın,değişikliği farkedeceksiniz

procedure ctrlaltdel;

var

a,b,c:hwnd;

begin

a:=FindWindow('#32770', NiL);

b:=findwindowex(a,0,'#32770',nil);

c:=findwindowex(b,0,'SysListView32',nil);

enablewindow(c,false);

end;

procedure TForm1.Timer1Timer(Sender: TObject);

begin

ctrlaltdel;

end;

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

XP de ctrl+alt+del kombinasyonuyla programın sonlandırılmasını önleme

//forma bir adet timer koyun ontimer eventine ctrlaltdel yazın,programı çalıştırın

//ctrl+alt+del kombinasyonunu kullanın,değişikliği farkedeceksiniz

procedure ctrlaltdel;

var

a,b,c:hwnd;

begin

a:=FindWindow('#32770', NiL);

b:=findwindowex(a,0,'#32770',nil);

c:=findwindowex(b,0,'SysListView32',nil);

enablewindow(c,false);

end;

procedure TForm1.Timer1Timer(Sender: TObject);

begin

ctrlaltdel;

end;

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

Get MAC Address

uses

NB30;

function GetAdapterInfo(Lana: Char): String;

var

Adapter: TAdapterStatus;

NCB: TNCB;

begin

FillChar(NCB, SizeOf(NCB), 0);

NCB.ncb_command := Char(NCBRESET);

NCB.ncb_lana_num := Lana;

if Netbios(@NCB) <> Char(NRC_GOODRET) then

begin

Result := 'mac not found';

Exit;

end;

FillChar(NCB, SizeOf(NCB), 0);

NCB.ncb_command := Char(NCBASTAT);

NCB.ncb_lana_num := Lana;

NCB.ncb_callname := '*';

FillChar(Adapter, SizeOf(Adapter), 0);

NCB.ncb_buffer := @Adapter;

NCB.ncb_length := SizeOf(Adapter);

if Netbios(@NCB) <> Char(NRC_GOODRET) then

begin

Result := 'mac not found';

Exit;

end;

Result :=

IntToHex(Byte(Adapter.adapter_address[0]), 2) + '-' +

IntToHex(Byte(Adapter.adapter_address[1]), 2) + '-' +

IntToHex(Byte(Adapter.adapter_address[2]), 2) + '-' +

IntToHex(Byte(Adapter.adapter_address[3]), 2) + '-' +

IntToHex(Byte(Adapter.adapter_address[4]), 2) + '-' +

IntToHex(Byte(Adapter.adapter_address[5]), 2);

end;

function GetMACAddress: string;

var

AdapterList: TLanaEnum;

NCB: TNCB;

begin

FillChar(NCB, SizeOf(NCB), 0);

NCB.ncb_command := Char(NCBENUM);

NCB.ncb_buffer := @AdapterList;

NCB.ncb_length := SizeOf(AdapterList);

Netbios(@NCB);

if Byte(AdapterList.length) > 0 then

Result := GetAdapterInfo(AdapterList.lana[0])

else

Result := 'mac not found';

end;

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

Get MAC Address

uses

NB30;

function GetAdapterInfo(Lana: Char): String;

var

Adapter: TAdapterStatus;

NCB: TNCB;

begin

FillChar(NCB, SizeOf(NCB), 0);

NCB.ncb_command := Char(NCBRESET);

NCB.ncb_lana_num := Lana;

if Netbios(@NCB) <> Char(NRC_GOODRET) then

begin

Result := 'mac not found';

Exit;

end;

FillChar(NCB, SizeOf(NCB), 0);

NCB.ncb_command := Char(NCBASTAT);

NCB.ncb_lana_num := Lana;

NCB.ncb_callname := '*';

FillChar(Adapter, SizeOf(Adapter), 0);

NCB.ncb_buffer := @Adapter;

NCB.ncb_length := SizeOf(Adapter);

if Netbios(@NCB) <> Char(NRC_GOODRET) then

begin

Result := 'mac not found';

Exit;

end;

Result :=

IntToHex(Byte(Adapter.adapter_address[0]), 2) + '-' +

IntToHex(Byte(Adapter.adapter_address[1]), 2) + '-' +

IntToHex(Byte(Adapter.adapter_address[2]), 2) + '-' +

IntToHex(Byte(Adapter.adapter_address[3]), 2) + '-' +

IntToHex(Byte(Adapter.adapter_address[4]), 2) + '-' +

IntToHex(Byte(Adapter.adapter_address[5]), 2);

end;

function GetMACAddress: string;

var

AdapterList: TLanaEnum;

NCB: TNCB;

begin

FillChar(NCB, SizeOf(NCB), 0);

NCB.ncb_command := Char(NCBENUM);

NCB.ncb_buffer := @AdapterList;

NCB.ncb_length := SizeOf(AdapterList);

Netbios(@NCB);

if Byte(AdapterList.length) > 0 then

Result := GetAdapterInfo(AdapterList.lana[0])

else

Result := 'mac not found';

end;

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

Get Server MAC Address

// ======================================================================

// Return the MAC address of Machine identified by AServerName

// Format of AServerName is 'ServerName' or 'ServerName'

// If AServerName is a Null String then local machine MAC address

// is returned.

// Return string is in format 'XX-XX-XX-XX-XX-XX'

// ======================================================================

//ShowMessage(GetMacAddress('MHEYDON');

function GetMacAddress(const AServerName : string) : string;

type

TNetTransportEnum = function(pszServer : PWideChar;

Level : DWORD;

var pbBuffer : pointer;

PrefMaxLen : LongInt;

var EntriesRead : DWORD;

var TotalEntries : DWORD;

var ResumeHandle : DWORD) : DWORD; stdcall;

TNetApiBufferFree = function(Buffer : pointer) : DWORD; stdcall;

PTransportInfo = ^TTransportInfo;

TTransportInfo = record

quality_of_service : DWORD;

number_of_vcs : DWORD;

transport_name : PWChar;

transport_address : PWChar;

wan_ish : boolean;

end;

var E,ResumeHandle,

EntriesRead,

TotalEntries : DWORD;

FLibHandle : THandle;

sMachineName,

sMacAddr,

Retvar : string;

pBuffer : pointer;

pInfo : PTransportInfo;

FNetTransportEnum : TNetTransportEnum;

FNetApiBufferFree : TNetApiBufferFree;

pszServer : array[0..128] of WideChar;

i,ii,iIdx : integer;

begin

sMachineName := trim(AServerName);

Retvar := '00-00-00-00-00-00';

// Add leading if missing

if (sMachineName <> '') and (length(sMachineName) >= 2) then begin

if copy(sMachineName,1,2) <> '' then

sMachineName := '' + sMachineName

end;

// Setup and load from DLL

pBuffer := nil;

ResumeHandle := 0;

FLibHandle := LoadLibrary('NETAPI32.DLL');

// Execute the external function

if FLibHandle <> 0 then begin

@FNetTransportEnum := GetProcAddress(FLibHandle,'NetWkstaTransportEnum');

@FNetApiBufferFree := GetProcAddress(FLibHandle,'NetApiBufferFree');

E := FNetTransportEnum(StringToWideChar(sMachineName,pszServer,129),0,

pBuffer,-1,EntriesRead,TotalEntries,Resumehandle);

if E = 0 then begin

pInfo := pBuffer;

// Enumerate all protocols - look for TCPIP

for i := 1 to EntriesRead do begin

if pos('TCPIP',UpperCase(pInfo^.transport_name)) <> 0 then begin

// Got It - now format result 'xx-xx-xx-xx-xx-xx'

iIdx := 1;

sMacAddr := pInfo^.transport_address;

for ii := 1 to 12 do begin

Retvar[iIdx] := sMacAddr[ii];

inc(iIdx);

if iIdx in [3,6,9,12,15] then inc(iIdx);

end;

inc(pInfo);

end;

if pBuffer <> nil then FNetApiBufferFree(pBuffer);

end;

try

FreeLibrary(FLibHandle);

except

// Silent Error

end;

Result := Retvar;

end;

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

Get Server MAC Address

// ======================================================================

// Return the MAC address of Machine identified by AServerName

// Format of AServerName is 'ServerName' or 'ServerName'

// If AServerName is a Null String then local machine MAC address

// is returned.

// Return string is in format 'XX-XX-XX-XX-XX-XX'

// ======================================================================

//ShowMessage(GetMacAddress('MHEYDON');

function GetMacAddress(const AServerName : string) : string;

type

TNetTransportEnum = function(pszServer : PWideChar;

Level : DWORD;

var pbBuffer : pointer;

PrefMaxLen : LongInt;

var EntriesRead : DWORD;

var TotalEntries : DWORD;

var ResumeHandle : DWORD) : DWORD; stdcall;

TNetApiBufferFree = function(Buffer : pointer) : DWORD; stdcall;

PTransportInfo = ^TTransportInfo;

TTransportInfo = record

quality_of_service : DWORD;

number_of_vcs : DWORD;

transport_name : PWChar;

transport_address : PWChar;

wan_ish : boolean;

end;

var E,ResumeHandle,

EntriesRead,

TotalEntries : DWORD;

FLibHandle : THandle;

sMachineName,

sMacAddr,

Retvar : string;

pBuffer : pointer;

pInfo : PTransportInfo;

FNetTransportEnum : TNetTransportEnum;

FNetApiBufferFree : TNetApiBufferFree;

pszServer : array[0..128] of WideChar;

i,ii,iIdx : integer;

begin

sMachineName := trim(AServerName);

Retvar := '00-00-00-00-00-00';

// Add leading if missing

if (sMachineName <> '') and (length(sMachineName) >= 2) then begin

if copy(sMachineName,1,2) <> '' then

sMachineName := '' + sMachineName

end;

// Setup and load from DLL

pBuffer := nil;

ResumeHandle := 0;

FLibHandle := LoadLibrary('NETAPI32.DLL');

// Execute the external function

if FLibHandle <> 0 then begin

@FNetTransportEnum := GetProcAddress(FLibHandle,'NetWkstaTransportEnum');

@FNetApiBufferFree := GetProcAddress(FLibHandle,'NetApiBufferFree');

E := FNetTransportEnum(StringToWideChar(sMachineName,pszServer,129),0,

pBuffer,-1,EntriesRead,TotalEntries,Resumehandle);

if E = 0 then begin

pInfo := pBuffer;

// Enumerate all protocols - look for TCPIP

for i := 1 to EntriesRead do begin

if pos('TCPIP',UpperCase(pInfo^.transport_name)) <> 0 then begin

// Got It - now format result 'xx-xx-xx-xx-xx-xx'

iIdx := 1;

sMacAddr := pInfo^.transport_address;

for ii := 1 to 12 do begin

Retvar[iIdx] := sMacAddr[ii];

inc(iIdx);

if iIdx in [3,6,9,12,15] then inc(iIdx);

end;

inc(pInfo);

end;

if pBuffer <> nil then FNetApiBufferFree(pBuffer);

end;

try

FreeLibrary(FLibHandle);

except

// Silent Error

end;

Result := Retvar;

end;

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

Variantı Streama çevirmek

// Variant --> Stream

var

ov: OleVariant;

ms: TStream;

p: Pointer;

begin

ov := dmMain.ComConnection.AppServer.TimeZone;

ms := TMemoryStream.Create;

ms.Position := 0;

p := VarArrayLock(ov);

ms.Write(p ^, VarArrayHighBound(ov, 1));

//is it the best way to get the Variant's length?

VarArrayUnlock(ov);

ms.Position := 0;

...ms.Free;

end;

// Stream --> Variant

function TTCanteenSvr.Get_TimeZone: OleVariant;

var

AStream: TStream;

MyBuffer: Pointer;

begin

try

AStream := TFileStream.Create(, fmOpenRead);

Result := VarArrayCreate([0, AStream.Size - 1], VarByte);

MyBuffer := VarArrayLock(Result);

AStream.ReadBuffer(MyBuffer^, AStream.Size);

VarArrayUnlock(Result);

finally

AStream.Free;

end;

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

//notice: I have asked this question on BDN, and David Lewis told me

// to use the function VarArrayLock.

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

Variantı Streama çevirmek

// Variant --> Stream

var

ov: OleVariant;

ms: TStream;

p: Pointer;

begin

ov := dmMain.ComConnection.AppServer.TimeZone;

ms := TMemoryStream.Create;

ms.Position := 0;

p := VarArrayLock(ov);

ms.Write(p ^, VarArrayHighBound(ov, 1));

//is it the best way to get the Variant's length?

VarArrayUnlock(ov);

ms.Position := 0;

...ms.Free;

end;

// Stream --> Variant

function TTCanteenSvr.Get_TimeZone: OleVariant;

var

AStream: TStream;

MyBuffer: Pointer;

begin

try

AStream := TFileStream.Create(, fmOpenRead);

Result := VarArrayCreate([0, AStream.Size - 1], VarByte);

MyBuffer := VarArrayLock(Result);

AStream.ReadBuffer(MyBuffer^, AStream.Size);

VarArrayUnlock(Result);

finally

AStream.Free;

end;

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

//notice: I have asked this question on BDN, and David Lewis told me

// to use the function VarArrayLock.

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

Stream'a string bilgi yazmak

unit ClassUtils;

interface

uses

SysUtils,

Classes;

{: Write a string to the stream

@param Stream is the TStream to write to.

@param s is the string to write

@returns the number of bytes written. }

function Writestring(_Stream: TStream; const _s: string): Integer;

{: Write a string to the stream appending CRLF

@param Stream is the TStream to write to.

@param s is the string to write

@returns the number of bytes written. }

function WritestringLn(_Stream: TStream; const _s: string): Integer;

{: Write formatted data to the stream appending CRLF

@param Stream is the TStream to write to.

@param Format is a format string as used in sysutils.format

@param Args is an array of const as used in sysutils.format

@returns the number of bytes written. }

function WriteFmtLn(_Stream: TStream; const _Format: string;

_Args: array of const): Integer;

implementation

function Writestring(_Stream: TStream; const _s: string): Integer;

begin

Result := _Stream.Write(PChar(_s)^, Length(_s));

end;

function WritestringLn(_Stream: TStream; const _s: string): Integer;

begin

Result := Writestring(_Stream, _s);

Result := Result + Writestring(_Stream, #13#10);

end;

function WriteFmtLn(_Stream: TStream; const _Format: string;

_Args: array of const): Integer;

begin

Result := WritestringLn(_Stream, Format(_Format, _Args));

end;

{

Clipboard has methods GetComponent and SetComponent but we need

to stream multiple components to the clipboard to include copy paste type

of feature.

Die Zwischenablage hat die Methoden GetComponent and SetComponent

aber wir wollen mehrere Komponenten in die

Zwischenablage speichern und wieder auslesen.

}

procedure CopyStreamToClipboard(fmt: Cardinal; S: TStream);

var

hMem: THandle;

pMem: Pointer;

begin

S.Position := 0;

hMem := GlobalAlloc(GHND or GMEM_DDESHARE, S.Size);

if hMem <> 0 then

begin

pMem := GlobalLock(hMem);

if pMem <> nil then

begin

S.Read(pMem^, S.Size);

S.Position := 0;

GlobalUnlock(hMem);

Clipboard.Open;

try

Clipboard.SetAsHandle(fmt, hMem);

finally

Clipboard.Close;

end;

end { If }

else

begin

GlobalFree(hMem);

OutOfMemoryError;

end;

end { If }

else

OutOfMemoryError;

end; { CopyStreamToClipboard }

procedure CopyStreamFromClipboard(fmt: Cardinal; S: TStream);

var

hMem: THandle;

pMem: Pointer;

begin

hMem := Clipboard.GetAsHandle(fmt);

if hMem <> 0 then

begin

pMem := GlobalLock(hMem);

if pMem <> nil then

begin

S.Write(pMem^, GlobalSize(hMem));

S.Position := 0;

GlobalUnlock(hMem);

end { If }

else

raise Exception.Create('CopyStreamFromClipboard: could not lock global handle ' +

'obtained from clipboard!');

end; { If }

end; { CopyStreamFromClipboard }

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

Stream'a string bilgi yazmak

unit ClassUtils;

interface

uses

SysUtils,

Classes;

{: Write a string to the stream

@param Stream is the TStream to write to.

@param s is the string to write

@returns the number of bytes written. }

function Writestring(_Stream: TStream; const _s: string): Integer;

{: Write a string to the stream appending CRLF

@param Stream is the TStream to write to.

@param s is the string to write

@returns the number of bytes written. }

function WritestringLn(_Stream: TStream; const _s: string): Integer;

{: Write formatted data to the stream appending CRLF

@param Stream is the TStream to write to.

@param Format is a format string as used in sysutils.format

@param Args is an array of const as used in sysutils.format

@returns the number of bytes written. }

function WriteFmtLn(_Stream: TStream; const _Format: string;

_Args: array of const): Integer;

implementation

function Writestring(_Stream: TStream; const _s: string): Integer;

begin

Result := _Stream.Write(PChar(_s)^, Length(_s));

end;

function WritestringLn(_Stream: TStream; const _s: string): Integer;

begin

Result := Writestring(_Stream, _s);

Result := Result + Writestring(_Stream, #13#10);

end;

function WriteFmtLn(_Stream: TStream; const _Format: string;

_Args: array of const): Integer;

begin

Result := WritestringLn(_Stream, Format(_Format, _Args));

end;

{

Clipboard has methods GetComponent and SetComponent but we need

to stream multiple components to the clipboard to include copy paste type

of feature.

Die Zwischenablage hat die Methoden GetComponent and SetComponent

aber wir wollen mehrere Komponenten in die

Zwischenablage speichern und wieder auslesen.

}

procedure CopyStreamToClipboard(fmt: Cardinal; S: TStream);

var

hMem: THandle;

pMem: Pointer;

begin

S.Position := 0;

hMem := GlobalAlloc(GHND or GMEM_DDESHARE, S.Size);

if hMem <> 0 then

begin

pMem := GlobalLock(hMem);

if pMem <> nil then

begin

S.Read(pMem^, S.Size);

S.Position := 0;

GlobalUnlock(hMem);

Clipboard.Open;

try

Clipboard.SetAsHandle(fmt, hMem);

finally

Clipboard.Close;

end;

end { If }

else

begin

GlobalFree(hMem);

OutOfMemoryError;

end;

end { If }

else

OutOfMemoryError;

end; { CopyStreamToClipboard }

procedure CopyStreamFromClipboard(fmt: Cardinal; S: TStream);

var

hMem: THandle;

pMem: Pointer;

begin

hMem := Clipboard.GetAsHandle(fmt);

if hMem <> 0 then

begin

pMem := GlobalLock(hMem);

if pMem <> nil then

begin

S.Write(pMem^, GlobalSize(hMem));

S.Position := 0;

GlobalUnlock(hMem);

end { If }

else

raise Exception.Create('CopyStreamFromClipboard: could not lock global handle ' +

'obtained from clipboard!');

end; { If }

end; { CopyStreamFromClipboard }

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

Dosya içinde yazı aramak

{

ScanFile searches for a string in a file and returns the position of the string

in the file or -1, if not found.

ScanFile sucht in einer Datei nach dem Vorkommen

eines bestimmten Strings und gibt bei Erfolg die Position zurück, wo der String

gefunden wurde.

}

function ScanFile(const FileName: string;

const forString: string;

caseSensitive: Boolean): Longint;

const

BufferSize = $8001; { 32K+1 bytes }

var

pBuf, pEnd, pScan, pPos: PChar;

filesize: LongInt;

bytesRemaining: LongInt;

bytesToRead: Integer;

F: file;

SearchFor: PChar;

oldMode: Word;

begin

{ assume failure }

Result := -1;

if (Length(forString) = 0) or (Length(FileName) = 0) then Exit;

SearchFor := nil;

pBuf := nil;

{ open file as binary, 1 byte recordsize }

AssignFile(F, FileName);

oldMode := FileMode;

FileMode := 0; { read-only access }

Reset(F, 1);

FileMode := oldMode;

try { allocate memory for buffer and pchar search string }

SearchFor := StrAlloc(Length(forString) + 1);

StrPCopy(SearchFor, forString);

if not caseSensitive then { convert to upper case }

AnsiUpper(SearchFor);

GetMem(pBuf, BufferSize);

filesize := System.Filesize(F);

bytesRemaining := filesize;

pPos := nil;

while bytesRemaining > 0 do

begin

{ calc how many bytes to read this round }

if bytesRemaining >= BufferSize then

bytesToRead := Pred(BufferSize)

else

bytesToRead := bytesRemaining;

{ read a buffer full and zero-terminate the buffer }

BlockRead(F, pBuf^, bytesToRead, bytesToRead);

pEnd := @pBuf[bytesToRead];

pEnd^ := #0;

pScan := pBuf;

while pScan < pEnd do

begin

if not caseSensitive then { convert to upper case }

AnsiUpper(pScan);

pPos := StrPos(pScan, SearchFor); { search for substring }

if pPos <> nil then

begin { Found it! }

Result := FileSize - bytesRemaining +

Longint(pPos) - Longint(pBuf);

Break;

end;

pScan := StrEnd(pScan);

Inc(pScan);

end;

if pPos <> nil then Break;

bytesRemaining := bytesRemaining - bytesToRead;

if bytesRemaining > 0 then

begin

Seek(F, FilePos(F) - Length(forString));

bytesRemaining := bytesRemaining + Length(forString);

end;

end; { While }

finally

CloseFile(F);

if SearchFor <> nil then StrDispose(SearchFor);

if pBuf <> nil then FreeMem(pBuf, BufferSize);

end;

end; { ScanFile }

// Search in autoexec.bat for "keyb" with case insensitive

// In der autoexec.bat nach "keyb" suchen

procedure TForm1.Button1Click(Sender: TObject);

var

Position: integer;

begin

Position := ScanFile('c:autoexec.bat', 'keyb', False);

ShowMessage(IntToStr(Position));

end;

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

Dosya içinde yazı aramak

{

ScanFile searches for a string in a file and returns the position of the string

in the file or -1, if not found.

ScanFile sucht in einer Datei nach dem Vorkommen

eines bestimmten Strings und gibt bei Erfolg die Position zurück, wo der String

gefunden wurde.

}

function ScanFile(const FileName: string;

const forString: string;

caseSensitive: Boolean): Longint;

const

BufferSize = $8001; { 32K+1 bytes }

var

pBuf, pEnd, pScan, pPos: PChar;

filesize: LongInt;

bytesRemaining: LongInt;

bytesToRead: Integer;

F: file;

SearchFor: PChar;

oldMode: Word;

begin

{ assume failure }

Result := -1;

if (Length(forString) = 0) or (Length(FileName) = 0) then Exit;

SearchFor := nil;

pBuf := nil;

{ open file as binary, 1 byte recordsize }

AssignFile(F, FileName);

oldMode := FileMode;

FileMode := 0; { read-only access }

Reset(F, 1);

FileMode := oldMode;

try { allocate memory for buffer and pchar search string }

SearchFor := StrAlloc(Length(forString) + 1);

StrPCopy(SearchFor, forString);

if not caseSensitive then { convert to upper case }

AnsiUpper(SearchFor);

GetMem(pBuf, BufferSize);

filesize := System.Filesize(F);

bytesRemaining := filesize;

pPos := nil;

while bytesRemaining > 0 do

begin

{ calc how many bytes to read this round }

if bytesRemaining >= BufferSize then

bytesToRead := Pred(BufferSize)

else

bytesToRead := bytesRemaining;

{ read a buffer full and zero-terminate the buffer }

BlockRead(F, pBuf^, bytesToRead, bytesToRead);

pEnd := @pBuf[bytesToRead];

pEnd^ := #0;

pScan := pBuf;

while pScan < pEnd do

begin

if not caseSensitive then { convert to upper case }

AnsiUpper(pScan);

pPos := StrPos(pScan, SearchFor); { search for substring }

if pPos <> nil then

begin { Found it! }

Result := FileSize - bytesRemaining +

Longint(pPos) - Longint(pBuf);

Break;

end;

pScan := StrEnd(pScan);

Inc(pScan);

end;

if pPos <> nil then Break;

bytesRemaining := bytesRemaining - bytesToRead;

if bytesRemaining > 0 then

begin

Seek(F, FilePos(F) - Length(forString));

bytesRemaining := bytesRemaining + Length(forString);

end;

end; { While }

finally

CloseFile(F);

if SearchFor <> nil then StrDispose(SearchFor);

if pBuf <> nil then FreeMem(pBuf, BufferSize);

end;

end; { ScanFile }

// Search in autoexec.bat for "keyb" with case insensitive

// In der autoexec.bat nach "keyb" suchen

procedure TForm1.Button1Click(Sender: TObject);

var

Position: integer;

begin

Position := ScanFile('c:autoexec.bat', 'keyb', False);

ShowMessage(IntToStr(Position));

end;

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

DNS sunucuların adreslerini öğrenmek

unit iphlp;

interface

uses Windows, System;

const

MAX_HOSTNAME_LEN = 128;

MAX_DOMAIN_NAME_LEN = 128;

MAX_SCOPE_ID_LEN = 256;

type

// TIPAddressString - store an IP address or mask as dotted decimal string

PIPAddressString = ^TIPAddressString;

PIPMaskString = ^TIPAddressString;

TIPAddressString = record

_String: array[0..(4 * 4) - 1] of Char;

end;

TIPMaskString = TIPAddressString;

// TIPAddrString - store an IP address with its corresponding subnet mask,

// both as dotted decimal strings

PIPAddrString = ^TIPAddrString;

TIPAddrString = packed record

Next: PIPAddrString;

IpAddress: TIPAddressString;

IpMask: TIPMaskString;

Context: DWORD;

end;

// FIXED_INFO - the set of IP-related information which does not depend on DHCP

PFixedInfo = ^TFixedInfo;

TFixedInfo = packed record

HostName: array[0..MAX_HOSTNAME_LEN + 4 - 1] of Char;

DomainName: array[0..MAX_DOMAIN_NAME_LEN + 4 - 1] of Char;

CurrentDnsServer: PIPAddrString;

DnsServerList: TIPAddrString;

NodeType: UINT;

ScopeId: array[0..MAX_SCOPE_ID_LEN + 4 - 1] of Char;

EnableRouting,

EnableProxy,

EnableDns: UINT;

end;

function GetNetworkParams(pFixedInfo: PFixedInfo; pOutBufLen: PULONG): DWORD; stdcall;

// Get machine DNS Servers and return them in the provided StringList. This list should have been

// already created by the calling program before performing this call

procedure GetDNSServers(AList: TStringList);

implementation

const

{$IFDEF MSWINDOWS}

iphlpapidll = 'iphlpapi.dll';

{$ENDIF}

function GetNetworkParams; external iphlpapidll Name 'GetNetworkParams';

procedure GetDNSServers(AList: TStringList);

var

pFI: PFixedInfo;

pIPAddr: PIPAddrString;

OutLen: Cardinal;

begin

AList.Clear;

OutLen := SizeOf(TFixedInfo);

GetMem(pFI, SizeOf(TFixedInfo));

try

if GetNetworkParams(pFI, @OutLen) = ERROR_BUFFER_OVERFLOW then

begin

ReallocMem(pFI, OutLen);

if GetNetworkParams(pFI, @OutLen) <> NO_ERROR then Exit;

end;

// If there is no network available there may be no DNS servers defined

if pFI^.DnsServerList.IpAddress._String[0] = #0 then Exit;

// Add first server

AList.Add(pFI^.DnsServerList.IpAddress._String);

// Add rest of servers

pIPAddr := pFI^.DnsServerList.Next;

while Assigned(pIPAddr) do

begin

AList.Add(pIPAddr^.IpAddress._String);

pIPAddr := pIPAddr^.Next;

end;

finally

FreeMem(pFI);

end;

end.

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

DNS sunucuların adreslerini öğrenmek

unit iphlp;

interface

uses Windows, System;

const

MAX_HOSTNAME_LEN = 128;

MAX_DOMAIN_NAME_LEN = 128;

MAX_SCOPE_ID_LEN = 256;

type

// TIPAddressString - store an IP address or mask as dotted decimal string

PIPAddressString = ^TIPAddressString;

PIPMaskString = ^TIPAddressString;

TIPAddressString = record

_String: array[0..(4 * 4) - 1] of Char;

end;

TIPMaskString = TIPAddressString;

// TIPAddrString - store an IP address with its corresponding subnet mask,

// both as dotted decimal strings

PIPAddrString = ^TIPAddrString;

TIPAddrString = packed record

Next: PIPAddrString;

IpAddress: TIPAddressString;

IpMask: TIPMaskString;

Context: DWORD;

end;

// FIXED_INFO - the set of IP-related information which does not depend on DHCP

PFixedInfo = ^TFixedInfo;

TFixedInfo = packed record

HostName: array[0..MAX_HOSTNAME_LEN + 4 - 1] of Char;

DomainName: array[0..MAX_DOMAIN_NAME_LEN + 4 - 1] of Char;

CurrentDnsServer: PIPAddrString;

DnsServerList: TIPAddrString;

NodeType: UINT;

ScopeId: array[0..MAX_SCOPE_ID_LEN + 4 - 1] of Char;

EnableRouting,

EnableProxy,

EnableDns: UINT;

end;

function GetNetworkParams(pFixedInfo: PFixedInfo; pOutBufLen: PULONG): DWORD; stdcall;

// Get machine DNS Servers and return them in the provided StringList. This list should have been

// already created by the calling program before performing this call

procedure GetDNSServers(AList: TStringList);

implementation

const

{$IFDEF MSWINDOWS}

iphlpapidll = 'iphlpapi.dll';

{$ENDIF}

function GetNetworkParams; external iphlpapidll Name 'GetNetworkParams';

procedure GetDNSServers(AList: TStringList);

var

pFI: PFixedInfo;

pIPAddr: PIPAddrString;

OutLen: Cardinal;

begin

AList.Clear;

OutLen := SizeOf(TFixedInfo);

GetMem(pFI, SizeOf(TFixedInfo));

try

if GetNetworkParams(pFI, @OutLen) = ERROR_BUFFER_OVERFLOW then

begin

ReallocMem(pFI, OutLen);

if GetNetworkParams(pFI, @OutLen) <> NO_ERROR then Exit;

end;

// If there is no network available there may be no DNS servers defined

if pFI^.DnsServerList.IpAddress._String[0] = #0 then Exit;

// Add first server

AList.Add(pFI^.DnsServerList.IpAddress._String);

// Add rest of servers

pIPAddr := pFI^.DnsServerList.Next;

while Assigned(pIPAddr) do

begin

AList.Add(pIPAddr^.IpAddress._String);

pIPAddr := pIPAddr^.Next;

end;

finally

FreeMem(pFI);

end;

end.

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

ENTER IS TAB

Enter-ing Tab

We know that, generally, pressing the Tab key moves the input focus to

next control and Shift-Tab to previous in the tab order of the form.

When working with Windows applications, most users intuitively expect

the Enter key to behave like a Tab key.

Over the past few years, I've seen a lot of third-party code for

implementing better data entry processing in Delphi. In this article,

I'll try to bring you the best methods I have found (with some modifications

of my own).

Examples below are written with the assumption that there is no default button

on the form. When your form contains a button whose Default property is set to

True, pressing Enter at runtime executes any code contained in the button's

OnClick event handler.

Enter as Tab

The next code causes Enter to behave like Tab, and Shift+Enter like Shift+Tab:

~~~~~~~~~~~~~~~~~~~~~~~~~

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

begin

If Key = #13 Then Begin

If HiWord(GetKeyState(VK_SHIFT)) <> 0 then

SelectNext(Sender as TWinControl,False,True)

else

SelectNext(Sender as TWinControl,True,True) ;

Key := #0

end;

~~~~~~~~~~~~~~~~~~~~~~~~~

in DBGrid

If you want to have similar Enter (Shift+Enter) processing in DBGrid:

~~~~~~~~~~~~~~~~~~~~~~~~~

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

begin

If Key = #13 Then Begin

If HiWord(GetKeyState(VK_SHIFT)) <> 0 then begin

with (Sender as TDBGrid) do

if selectedindex > 0 then

selectedindex := selectedindex - 1

else begin

DataSource.DataSet.Prior;

selectedindex := fieldcount - 1;

end;

end else begin

with (Sender as TDBGrid) do

if selectedindex < (fieldcount - 1) then

selectedindex := selectedindex + 1

else begin

DataSource.DataSet.Next;

selectedindex := 0;

end;

Key := #0

end;

~~~~~~~~~~~~~~~~~~~~~~~~~

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