ganti atribut file

The following code reads a file's attributes into a set variable, sets the check boxes in a file-attribute dialog box to represent the current attributes, then executes the dialog box. If the user changes and accepts any dialog box settings, the code sets the file attributes to match the changed settings:

procedure TFMForm.Properties1Click(Sender: TObject);
var
Attributes, NewAttributes: Word;
begin
with FileAttrForm do
begin
FileDirName.Caption := FileList.Items[FileList.ItemIndex];
{ set box caption }
PathName.Caption := FileList.Directory;
{ show directory name }
ChangeDate.Caption :=
DateTimeToStr(FileDateToDateTime(FileAge(FileList.FileName)));
Attributes := FileGetAttr(FileDirName.Caption);
{ read file attributes }
ReadOnly.Checked := (Attributes and SysUtils.faReadOnly) = faReadOnly;
Archive.Checked := (Attributes and faArchive) = faArchive;
System.Checked := (Attributes and faSysFile) = faSysFile;
Hidden.Checked := (Attributes and faHidden) = faHidden;
if ShowModal <> id_Cancel then { execute dialog box }
begin
NewAttributes := Attributes;
{ start with original attributes }
if ReadOnly.Checked then
NewAttributes := NewAttributes or SysUtils.faReadOnly
else
NewAttributes := NewAttributes and not SysUtils.faReadOnly;
if Archive.Checked then
NewAttributes := NewAttributes or faArchive
else
NewAttributes := NewAttributes and not faArchive;
if System.Checked then
NewAttributes := NewAttributes or faSysFile
else
NewAttributes := NewAttributes and not faSysFile;
if Hidden.Checked then
NewAttributes := NewAttributes or faHidden
else
NewAttributes := NewAttributes and not faHidden;
if NewAttributes <> Attributes then { if anything changed... }
FileSetAttr(FileDirName.Caption, NewAttributes);
{ ...write the new values }
end;
end;
end;

Delphi - membuka control panel

Membuka Control Panel

Gunakan kode di bawah ini untuk membuka Control Panel dari program Delphi Anda. Jangan lupa tampahkan ShellApi pada bagian uses :

procedure TForm1.Buton1Click(Sender : TObject);
begin
ShellExecute(Handle,\'Open\',\'control\',
nil,nil,SW_SHOWNORMAL);
end;

How to minimize to System Tray

unit Unit1;

interface

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

const
WM_NOTIFYICON = WM_USER+333;

type
TForm1 = class(TForm)

procedure FormCreate(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
tnid: TNotifyIconData;
HMainIcon: HICON;

procedure CMClickIcon(var msg: TMessage); message WM_NOTIFYICON;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}


procedure TForm1.CMClickIcon(var msg: TMessage);
begin
case msg.lparam of
WM_LBUTTONDBLCLK : Show;
end;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
HMainIcon := LoadIcon(MainInstance, \'MAINICON\');

Shell_NotifyIcon(NIM_DELETE, @tnid);

tnid.cbSize := sizeof(TNotifyIconData);
tnid.Wnd := handle;
tnid.uID := 123;
tnid.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
tnid.uCallbackMessage := WM_NOTIFYICON;
tnid.hIcon := HMainIcon;
tnid.szTip := \'POP3 Server\';

Shell_NotifyIcon(NIM_ADD, @tnid);
end;


procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caNone;
Hide;
end;



end.

shutdown komputer

Men-shutdown komputer

Untuk melakukan restart, shutdown atau log off komputer, gunakan fungsi ExitWindowsEx. Ada pun deklarasi dari fungsi ExitWindowsEx adalah sebagai berikut :

function ExitWindowsEx (uFlags : word ; dwReserved : DWORD): BOOL;

Parameter pertama menerangkan \"apa yang harus dilakukan\" oleh komputer. Parameter ini dapat bernilai :
Konstanta

Keterangan
EWX_RESTART Melakukan restart dengan menampilkan peringatan.
EWX_SHUTDOWN Melakukan shutdown dengan menampilkan peringatan.
EWX_LOGOFF Melakukan log off dengan menampilkan peringatan.
EWX_FORCE Melakukan shutdown tanpa menampilkan peringatan. Sehingga ada kemungkinan Anda akan kehilangan data yang belum disimpan (belum di-save).

Sedangkan parameter kedua bernilai 0.

Sehingga bila ingin melakukan shutdown cukup tulis kode berikut ini :

ExitWindowsEx (EWX_SHUTDOWN, 0);

Blog Delphi **** hendr13.blogspot.com ] ... [

Beberapa hari tidak memberikan tips dan trik rasanya koq aneh dalam hidup ini. btw, nggak papa lah...hidup ini kan tidak bisa stabil, kadang merasa diatas dan kadang merasa dibawah. Baiklah, kali ini akan diberikan tips kepada temen-temen yang ingin belajar database pemrograman terutama yang ada hubungannya dengan ADO Connection.

Kemudian untuk database engine yang dijadikan sebagai acuan disini adalah database engine MS SQL Server.

Disini anda akan diajarkan gimana aplikasi secara otomatis akan melakukan proses koneksi ulang k server tanpa kita harus melakukan secara manual. Dengan demikian, program kita tidak akan terkesan murahan ketika koneksi gagal dilakukan langsung muncul error.

langsung saja kita kembali ke pokok permasalahan yaitu gimana kita akan membuat connection string secara dinamis dengan menggunakan bantuan database registry. Untuk mengakses database regsitry dengan mudah dan cepat, disini dibantu dengan menggunakan object TRzRegIniFile yang diambil dari component pallete Raize Widgets.

Sekarang silahkan anda lakukan langkah-langkah seperti dibawah ini:

1. Apabila anda belum membuat program Delphi, silahkan anda buka terlebih dahulu.
2. Kemudian buat program aplikasi baru dan berikan nama project \"Project1\"
3. Simpan program aplikasi tersebut didalam folder yang aman.
4. Setelah itu, silahkan anda tambahkan beberapa object seperti dibawah ini kedalam form:
- ADOConnection1
- RzRegIniFile1
5. Lanjutkan dengan mengatur settingan object-object tersebut. Silahkan anda atur dengan settingan seperti ditunjukkan dibawah ini.

Untuk ADOConnection1 :
- LoginPrompt = False
- untuk properties yang lain sifatnya adalah default

Untuk RzRegIniFile1
- Path = \'Software\'
- PathType = ptRegistry
- untuk properties yang lain sifatnya adalah default

6. Jangan lupa untuk menambahkan library \"ComObj\" kedalam \"uses\". Untuk lebih jelas mengenai hal ini silahkan baca artikel ini
7. Sekarang silahkan pilih object \"Form1\"
8. Klik 2x object tersebut hingga dibuat procedure \"FormCreate\"
9. Kemudian silahkan anda isikan kode program didalam event tersebut seperti terlihat pada potongan kode program dibawah ini.

....
....
var
TeksKoneksi : String;
Password : String;
User : String;
Server : String;
Database : String;
TempStatus : String;
label
KoneksiUlang;
begin

// proses inisialisasi data variabel dari database registry
with RzRegIniFile1 do
begin
Password := ReadString(\'Config\',\'Password\',\'ekoindri\');
User := ReadString(\'Config\',\'User\',\'sa\');
Server := ReadString(\'Config\',\'Server\',\'(local)\');
Database := ReadString(\'Config\',\'Database\',\'Aurecosoft - Business Small Accounting\');
end;

// Memberikan inisialisasi data pada variabel TeksKoneksi
TeksKoneksi := \'Provider=SQLOLEDB.1;\' +
\'Password=%s;\' +
\'Persist Security Info=True;\' +
\'User ID=%s;\' +
\'Initial Catalog=%s;\' +
\'Data Source=%s\';

// Proses pembuatan ConnectionString
KoneksiUlang:

// proses koneksi ke database server

try
TempStatus := \'Sukses\';
Connected := True;
except
on EOleException do
begin
TempStatus := \'Gagal\';
end;
end;

// Apabila proses keneksi gagal, maka sistem akan melakukan koneksi ulang ke server hingga berhasil
// jika anda ingin membatasi hingga 5 kali koneksi gagal atau n koneksi gagal akan menutup aplikasi,
// maka, anda bisa gunakan parameter tambahan yang gunanya untuk meng-counter. Apabila parameter
// tersebut jumlahnya sesuai dengan jumlah batas koneksinya, maka applikasi langsung di terminate.
// Silahkan hal tersebut anda coba sendiri dan jadikan latihan untuk mengembangkan kemampuan anda

if TempStatus = \'Gagal\' then
goto KoneksiUlang;
end;
end;
....
....

10. Kemudian anda dapat meng-compile dan menjalankan program aplikasi tersebut dengan cara menekan tombol F9.
11. Tunggu beberapa saat hingga aplikasi benar2 siap jalan
12. Apabila Form1 muncul, itu artinya proses keneksi database telah berhasil dilakukan.
13. Sekali lagi, jangan lupa untuk menentukan data-data koneksinya didalam database registry.
14. Akan lebih baik, jika anda membuat aplikasi khusus yang tujuannya untuk memasukkan data konfigurasi database kedalam database registry, sehingga anda tidak perlu melakukan konfigurasi secara manual dengan membuka database registry.
15. Dari contoh diatas apabila sistem tidak menjumpai data konfigurasi database didalam databse registry, maka dia akan menggunakan data defaultnya. Untuk lebih jelasnya silahkan anda lihat potongan kode program dibawah ini.

....
....
with RzRegIniFile1 do
begin
Password := ReadString(\'Config\',\'Password\',\'ekoindri\');
User := ReadString(\'Config\',\'User\',\'sa\');
Server := ReadString(\'Config\',\'Server\',\'(local)\');
Database := ReadString(\'Config\',\'Database\',\'Aurecosoft - Business Small Accounting\');
end;
....
....

16. Semoga tips ini bisa berguna.

Silahkan anda berikan info ini kepada teman-teman anda yang lain agar mereka tidak kehilangan informasi yang mungkin sangat mereka butuhkan.

Delphi: Reading and writing a file to and from a string

Reading a file to a string

Perhaps the easiest way to read a file into a string is using the LoadFromFile method of a TStringList object and then accessing its Text property:

uses SysUtils, Classes;

function LoadFile(const FileName: TFileName): string;
begin
with TStringList.Create do
try
LoadFromFile(FileName);
Result := Text;
finally
Free;
end;
end;

Tips N Trik Delphi 7.0

Memberi Warna Pada Text Dalam Message Dialog ::::




Secara default warna teks pada kotak dialog akan mengikuti warna sesuai setting pada display properties. Dengan Sedikit tips di bawah ini anda dapat menampilkan kotak dialog dengan warna yang dapat anda tentukan sendiri.

Procedure TForm1.Button1Click(Sender:TObject);

var
MsgForm : TForm;
i : integer;

Begin
//Membuat Message Dialog
MsgForm := CreatedMessageDialog(\'Tulisan ini berwarna
Merah !!\',mtinformation,[mbOK]);

with MsgForm do
begin
for i := 0 to ComponentCount -1 do
if Components[i] is TLabel then
(components[i] as TLabel).Font.color :=clred;
ShowModal ;
end;
MsgForm.free;
end;

Are we connected to the Internet ?

procedure TForm1.Button1Click(Sender: TObject) ;



function FuncAvail(_dllname, _funcname: string;

var _p: pointer): boolean;

{return True if _funcname exists in _dllname}

var _lib: tHandle;

begin

Result := false;

if LoadLibrary(PChar(_dllname)) = 0 then exit;

_lib := GetModuleHandle(PChar(_dllname)) ;

if _lib &lt;&gt; 0 then begin

_p := GetProcAddress(_lib, PChar(_funcname)) ;

if _p &lt;&gt; NIL then Result := true;

end;

end;



{

Call SHELL32.DLL for Win &lt; Win98

otherwise call URL.dll

}

{button code:}

var

InetIsOffline : function(dwFlags: DWORD):

BOOL; stdcall;

begin

if FuncAvail('URL.DLL', 'InetIsOffline',

@InetIsOffline) then

if InetIsOffLine(0) = true

then ShowMessage('Not connected')

else ShowMessage('Connected!') ;

end;

Listbox With Multiple Columns

Delphi's TListBox control displays a collection of items in a
scrollable list. By design, a listbox displays its items in one column.

If you want to display several items in one row, thus have multiple
columns in a list box you need to set the TabWidth property and add
items to theListBox in a specific way.

begin

___ListBox1.Items.Add('First'^I'Second'^I'Third') ;
___ListBox1.Items.Add('C1R1'^I'C2R1'^I'C3R1') ;
___ListBox1.Items.Add('C1R2'^I'C2R2'^I'C3R2') ;
___ListBox1.Items.Add('C1R3'^I'C2R3'^I'C3R3') ;
___ListBox1.Items.Add('C1R4'^I'C2R4'^I'C3R4') ;
___ListBox1.Items.Add('C1R5'^I'C2R5'^I'C3R5') ;
___ListBox1.Items.Add('C1R6'^I'C2R6'^I'C3R6') ;
___ListBox1.Items.Add('C1R7'^I'C2R7'^I'C3R7') ;
___ListBox1.Items.Add('C1R8'^I'C2R8'^I'C3R8') ;


___ListBox1.Items.Add('C1R9'^I'C2R9'^I'C3R9') ;

end;

Make an Application window full screen

Set the Borderstyle of your main form to bsNone and then use
SystemParametersInfo message to get the SPI_GETWORKAREA value then use
SetBounds to make your Window the correct size.




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

procedure TSomeForm.FormShow(Sender: TObject) ;

var

r : TRect;

begin

Borderstyle := bsNone;

SystemParametersInfo

(SPI_GETWORKAREA, 0, @r,0) ;

SetBounds

(r.Left, r.Top, r.Right-r.Left, r.Bottom-r.Top) ;

end;

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

How to Minimize ALL the windows on the Desktop

~~~~~~~~~~~~~~~~~~~~~~~~~
uses ShlObj;

procedure Shell_MinimizeAll;
var
___Shell : OleVariant;
begin
___Shell := CreateOleObject('Shell.Application') ;
___Shell.MinimizeAll;
end;
~~~~~~~~~~~~~~~~~~~~~~~~~

Disable Screensaver

{Insert the following code into the
"public" section of
your main form:}


procedure AppMessage(var Msg : TMsg;var bHandled : boolean ) ;
{In the OnCreate for the main form add:}
Application.OnMessage := AppMessage;
{In the "implementation" section, insert the
following code (suppose Form1 is the name of your form):}

procedure TForm1.AppMessage(var Msg : TMsg;
___var bHandled : boolean ) ;
begin
___if((WM_SYSCOMMAND = Msg.Message) and
______(SC_SCREENSAVE = Msg.wParam) )then
______bHandled := True;
end;

Flip Bitmap (Horizontal or Vertical)

Here's a sample code that flips the bitmap vertical or horizontal
and creates a new bitmap:

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

{

Usage:
BitmapFlip(True,
False,
Image1.Picture.Bitmap,
Image1.Picture.Bitmap
) ;

}


interface
Uses Windows,Graphics;


Function BitmapFlip(
___Const Vertical : Boolean;
___Const Horizontal : Boolean;
var BitmapIn : TBitmap;
___ out BitmapOut : TBitmap): Boolean;


implementation


Type
___TColorData = Array[0..128000] Of TRGBTriple;
___pColorData = ^TColorData;

Function BitmapFlip( Const Vertical : Boolean;
_____________________Const Horizontal : Boolean;
var BitmapIn : TBitmap;
___out BitmapOut : TBitmap): Boolean;

Var DataIn : pColorData;
___DataOut : pColorData;
___inRow : Integer;
___inCol : Integer;

Begin
___Result := False;
___Try
___If BitmapIn.PixelFormat &lt;&gt; pf24bit Then Exit;
___With BitmapOut Do
___Begin
______Width := BitmapIn.Width;
______Height := BitmapIn.Height;
______PixelFormat := BitmapIn.PixelFormat;
___End;

___For inRow := 0 To BitmapIn.Height - 1 Do
___Begin
______DataIn := BitmapIn.Scanline[inRow];
______If Vertical Then
______Begin
_________DataOut := BitmapOut.ScanLine
_________[BitmapIn.Height - 1 - inRow];
______End
___Else
___Begin
______DataOut := BitmapOut.ScanLine[inRow];
___End;

___If Horizontal Then
___Begin
______For inCol := 0 To BitmapIn.Width-1 Do
_________DataOut[inCol] := DataIn[BitmapIn.Width-1-inCol];
___End
___Else
___Begin
______For inCol := 0 To BitmapIn.Width-1 Do
______DataOut[inCol] := DataIn[inCol];
___End;
___End;
______Result := True;
___Except
___End;
End;
End.


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

Get Default Printer Name

Iseng-iseng siapa tau ada manfaatnya


uses Printers;

function GetDefaultPrinterName : string;
begin
___if (Printer.PrinterIndex > 0)then begin
______Result := Printer.Printers[Printer.PrinterIndex];
___end else begin
______Result := '';
___end;
end;

Setting IP Address, Subnet dan Gateway computer di Delphi

Artikel dibawah ini menerangkan bagaimana setting IP Address, Subnet dan Gateway computer. Caya yang digunakan adalah dengan menggunakan class WMI API OLE

Contoh

jika SetIpConfig('192.168.1.5') = 0 maka Set ke STATIC IP
jika SetIpConfig('') = 0. Maka Set ke DHCP
jika SetupConfig('dhcp') = 0 Maka Set ke DHCP
jika SetIpConfig('196.11.175.221','196.11.175.1') = 0 itu berarti menuliskan IP STATIC + GATEWAY

Unit reference yang digunakan adalah : ComObj, ActiveX, UrlMon

Function yang akan dubuat adalah :
function SetIpConfig(const AIpAddress : string; const AGateWay : string = ''; const ASubnetMask : string = '') : integer;
function SetDnsServers(const APrimaryDNS : string; const AAlternateDNS : string = '') : integer;

Dengan Return Value sbb :
0 Successful completion, no reboot required.
1 Successful completion, reboot required.
-1 Unknown OLE Error
64 Method not supported on this platform.
65 Unknown failure.
66 Invalid subnet mask.
67 An error occurred while processing an instance that was returned.
68 Invalid input parameter.
69 More than five gateways specified.
70 Invalid IP address.
71 Invalid gateway IP address.
72 An error occurred while accessing the registry for the info.
73 Invalid domain name.
74 Invalid host name.
75 No primary or secondary WINS server defined.
76 Invalid file.
77 Invalid system path.
78 File copy failed.
79 Invalid security parameter.
80 Unable to configure TCP/IP service.
81 Unable to configure DHCP service.
82 Unable to renew DHCP lease.
83 Unable to release DHCP lease.
84 IP not enabled on adapter.
85 IPX not enabled on adapter.
86 Frame/network number bounds error.
87 Invalid frame type.
88 Invalid network number.
89 Duplicate network number.
90 Parameter out of bounds.
91 Access denied.
92 Out of memory.
93 Already exists.
94 Path, file, or object not found.
95 Unable to notify service.
96 Unable to notify DNS service.
97 Interface not configurable.
98 Not all DHCP leases could be released or renewed.
100 DHCP not enabled on adapter.

---------------------------------------------------------}

uses ComObj, ActiveX, UrlMon;


function SetIpConfig(const AIpAddress : string; const AGateWay : string = '';
const ASubnetMask : string = '') : integer;
var Retvar : integer;
___oBindObj : IDispatch;
___oNetAdapters,oNetAdapter,
___oIpAddress,oGateWay,
___oWMIService,oSubnetMask : OleVariant;
___i,iValue : longword;
___oEnum : IEnumvariant;
___oCtx : IBindCtx;
___oMk : IMoniker;
___sFileObj : widestring;
begin
___Retvar := 0;
___sFileObj := 'winmgmts:\\.\root\cimv2';

___// Create OLE [IN} Parameters
___oIpAddress := VarArrayCreate([1,1],varOleStr);
___oIpAddress[1] := AIpAddress;
___oGateWay := VarArrayCreate([1,1],varOleStr);
___oGateWay[1] := AGateWay;
___oSubnetMask := VarArrayCreate([1,1],varOleStr);
___if ASubnetMask = '' then
______oSubnetMask[1] := '255.255.255.0'
___else
______oSubnetMask[1] := ASubnetMask;

___// Connect to WMI - Emulate API GetObject()
___OleCheck(CreateBindCtx(0,oCtx));
___OleCheck(MkParseDisplayNameEx(oCtx,PWideChar(sFileObj),i,oMk));
___OleCheck(oMk.BindToObject(oCtx,nil,IUnknown,oBindObj));
___oWMIService := oBindObj;

oNetAdapters := oWMIService.ExecQuery('Select * from ' +
__________________ 'Win32_NetworkAdapterConfiguration ' +
__________________ 'where IPEnabled=TRUE');
___oEnum := IUnknown(oNetAdapters._NewEnum) as IEnumVariant;

___while oEnum.Next(1,oNetAdapter,iValue) = 0 do begin
___try
______// Set by DHCP ? (Gateway and Subnet ignored)
______if (AIpAddress = '') or SameText(AIpAddress,'DHCP') then
_________Retvar := oNetAdapter.EnableDHCP
______// Set via STATIC ?
______else begin
_________Retvar := oNetAdapter.EnableStatic(oIpAddress,oSubnetMask);
_________// Change Gateway ?
_________if (Retvar = 0) and (AGateWay <> '') then
____________Retvar := oNetAdapter.SetGateways(oGateway);

______end;
___except
_________Retvar := -1;
___end;

______oNetAdapter := Unassigned;
___end;

___oGateWay := Unassigned;
___oSubnetMask := Unassigned;
___oIpAddress := Unassigned;
___oNetAdapters := Unassigned;
___oWMIService := Unassigned;
___Result := Retvar;
end;



function SetDnsServers(const APrimaryDNS : string;
__________________ const AAlternateDNS : string = '') : integer;
var Retvar : integer;
___oBindObj : IDispatch;
___oNetAdapters,oNetAdapter,
___oDnsAddr,oWMIService : OleVariant;
___i,iValue,iSize : longword;
___oEnum : IEnumvariant;
___oCtx : IBindCtx;
___oMk : IMoniker;
___sFileObj : widestring;
begin
___Retvar := 0;
___sFileObj := 'winmgmts:\\.\root\cimv2';
___iSize := 0;
___if APrimaryDNS <> '' then inc(iSize);
___if AAlternateDNS <> '' then inc(iSize);

___// Create OLE [IN} Parameters
___if iSize > 0 then begin
______oDnsAddr := VarArrayCreate([1,iSize],varOleStr);
______oDnsAddr[1] := APrimaryDNS;
______if iSize > 1 then oDnsAddr[2] := AAlternateDNS;
___end;

___// Connect to WMI - Emulate API GetObject()
___OleCheck(CreateBindCtx(0,oCtx));
___OleCheck(MkParseDisplayNameEx(oCtx,PWideChar(sFileObj),i,oMk));
___OleCheck(oMk.BindToObject(oCtx,nil,IUnknown,oBindObj));
___oWMIService := oBindObj;

___oNetAdapters := oWMIService.ExecQuery('Select * from ' +
_________ 'Win32_NetworkAdapterConfiguration ' +
_________ 'where IPEnabled=TRUE');
___oEnum := IUnknown(oNetAdapters._NewEnum) as IEnumVariant;
___while oEnum.Next(1,oNetAdapter,iValue) = 0 do begin
___try
______if iSize > 0 then
_________Retvar := oNetAdapter.SetDNSServerSearchOrder(oDnsAddr)
______else
_________Retvar := oNetAdapter.SetDNSServerSearchOrder();
___except
______Retvar := -1;
___end;

______oNetAdapter := Unassigned;
___end;

___oDnsAddr := Unassigned;
___oNetAdapters := Unassigned;
___oWMIService := Unassigned;
___Result := Retvar;
end;



fungsi lain yang ada pada Win32_NetworkAdapterConfiguration Class

DisableIPSec
EnableDHCP
EnableDNS
EnableIPFilterSec
EnableIPSec
EnableStatic
EnableWINS
ReleaseDHCPLease
ReleaseDHCPLeaseAll
RenewDHCPLease
RenewDHCPLeaseAll
SetArpAlwaysSourceRoute
SetArpUseEtherSNAP
SetDatabasePath
SetDeadGWDetect
SetDefaultTTL
SetDNSDomain
SetDNSServerSearchOrder
SetDNSSuffixSearchOrder
SetDynamicDNSRegistration
SetForwardBufferMemory Specifies
SetGateways
SetIGMPLevel
SetIPConnectionMetric
SetIPUseZeroBroadcast
SetIPXFrameTypeNetworkPairs
SetIPXVirtualNetworkNumber
SetKeepAliveInterval
SetKeepAliveTime
SetNumForwardPackets
SetPMTUBHDetect
SetPMTUDiscovery
SetTcpipNetbios
SetTcpMaxConnectRetransmissions
SetTcpMaxDataRetransmissions
SetTcpNumConnections
SetTcpUseRFC1122UrgentPointer
SetTcpWindowSize
SetWINSServer

Mengetahui & Mengubah Computer Name

Terkadang kita ingin mengubah computer name melalui aplikasi yang kita buat. berikut ini adalah cara untuk membaca nama komputer dan merubah nama komputer

{Membaca nama komputer }

function GetComputerName: string;
var
___buffer: array[0..MAX_COMPUTERNAME_LENGTH + 1] of Char;
___Size: Cardinal;
begin
___Size := MAX_COMPUTERNAME_LENGTH + 1;
___Windows.GetComputerName(@buffer, Size);
___Result := StrPas(buffer);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
___ShowMessage(GetComputerName);
end;


{ Merubah nama komputer - untuk merubah pastikan login dg hak administrator}

function SetComputerName(AComputerName: string): Boolean;
var
___ComputerName: array[0..MAX_COMPUTERNAME_LENGTH + 1] of Char;
___Size: Cardinal;
begin
___StrPCopy(ComputerName, AComputerName);
___Result := Windows.SetComputerName(ComputerName);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
___if SetComputerName('NewComputerName') then
______ShowMessage('Computer Name Reset Setting will be used at next startup.')
___else
______ ShowMessage('Computer Name Not Reset');
end;


Selamat Mencoba.. Semoga berhasil

Creating and Using DLLs from Delphi

Introduction to DLLs. How to create (and use) a DLL in Delphi A Dynamic Link library, or DLL, is a collection of routines (small programs) that can be called by applications and by other DLLs. Like units, DLLs contain sharable code or resources, they provide the ability for multiple applications to share a single copy of a routine they have in common. The concept of DLLs is the core of the Windows architectural design, and for the most part Windows is simply a collection of DLLs. Naturally, using Delphi, we can write and use our own DLLs, and we can call functions in DLLs developed with other systems / by other developers (like Visual Basic, or C/C++). Creating a Dynamic Link Library The following few lines will demonstrate how to create a simple DLL using Delphi. For the beginning start Delphi and select File | New ... DLL. This will create a new DLL template in the editor window. Select the default text and replace it with the next piece of code. library TestLibrary; uses SysUtils, Classes, Dialogs; procedure DllMessage; export; ___begin ShowMessage('Hello world from a Delphi DLL') ; end; exports DllMessage; begin end. If you look at the project file of any Delphi application, you’ll see that it starts with the reserved word Program. By contrast, DLLs always begin with the reserved word Library. This is then followed by a uses clause for any needed units. In this simple example, there then follows a procedure called DllMessage which does nothing except showing a simple message. At the end of the source code we find an exports statement. This lists the routines that are actually exported from the DLL in a way that they can be called by another application. What this means is that we can have, let's say, 5 procedures in a DLL and only 2 of them (listed in the exports section) can be called from an external program (the remaining 3 are "sub procedures" in a DLL). In order to use this simple DLL, we have to compile it by pressing Ctrl+F9. This should create a DLL called SimpleMessageDLL.DLL in your projects folder. Finally, let's see how to call the DllMessage procedure from a (statically loaded) DLL. To import a procedure contained in a DLL, we use the keyword external in the procedure declaration. For example, given the DllMessage procedure shown earlier, the declaration in the calling application would look like : procedure DllMessage; external 'SimpleMessageDLL.dll' the actual call to a procedure will be nothing more than DllMessage; The entire code for a Delphi form (name: Form1) with a TButton on it (name: Button1) that's calls the DLLMessage function could be: unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) Button1: TButton; procedure Button1Click(Sender: TObject) ; private { Private declarations } public { Public declarations } end; var Form1: TForm1; procedure DllMessage; external 'SimpleMessageDLL.dll' implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject) ; begin DllMessage; end; end. That all! As simple as only Delphi can be. For more info on creating and using Dynamic Link Libraries from Delphi: Everything you ever wanted to know about DLLs and Delphi but didn't know where to look for answers (or were to afraid to ask). Papers, tutorials, articles, code, what, how, why, when, where...

Disable Ctrl+V shortcut pada TEdit

Terkadang anda mengiginkan agar user tidak dapat menggunakan fitur Crtl+V atatu Ctrl+C pada component yang memiliki input focus

Hal tersebut dapat dilakukan dengan cara sebagai berikut :

Misalkan kita menggunakan komponen TEdit

pastikan unit anda menggunakan class ClipBrd

uses Clipbrd, ...

Pada event Onkeydown edit1 tuliskan perintah sebagai berikut :

//disable CTRL + V ("Paste") :: handles Edit1.OnKeyDown
procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState) ;
begin
___if ((ssCtrl in Shift) AND (Key = ord('V'))) then
___begin
______if Clipboard.HasFormat(CF_TEXT) then ClipBoard.Clear;
______Edit1.SelText := '"Paste" DISABLED!';
______Key := 0;
___end;
end;


Selamat mencoba semoga berhasil.....

Coloring the DBGrid

How to enhance the functionality of a TDBgrid component using colors
Adding color to your database grids will enhance the appearance and differentiate the importance of certain rows or columns within the database. Since the DBGrid is a great user interface tool for displaying data, this article will focus on questions like "How do I change the color of particular row / column / cell in a DBGrid?" Preparations This article assumes that you know how to connect a database to DBGrid component. The easiest way to accomplish this is to use the Database Form Wizard. Select the employee.db from DBDemos alias. Select all fields except EmpNo. Note: if you do not wont to work with the BDE, consider the chapters of the Free Database Course For Beginner Delphi Developers - Focus on ADO. Coloring Columns The first (and the easiest) thing you can do, to visually enhance the user interface, is to color individual column in the data-aware grid. We will accomplish this through TColumns property of the grid. Select the grid component in the form and invoke the Columns editor by double clicking on the grid's Columns property in the Object Inspector. For more information on Columns editor look for "Columns editor: creating persistent columns" in your Delphi help files. Now, everything you have to do is to specify the background color of the cells of the particular column. For text foreground color, see the font property. This is what I have done, after few clicks... You have to agree that this is much better that the standard black'n'white grid (of course, use colors if you really need them). Coloring Rows If you want to color the selected row in a DBGrid but you don't want to use the dgRowSelect option because you want to be able to edit the data you should use the DBGrid.OnDrawColumnCell event. This technique demonstrates how to dynamically change the color of text in a DBGrid: procedure TForm1.DBGrid1DrawColumnCell (Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); begin if Table1.FieldByName('Salary').AsCurrency>36000 then DBGrid1.Canvas.Font.Color:=clMaroon; DBGrid1.DefaultDrawColumnCell (Rect, DataCol, Column, State); end; If an employee's salary is greater than 36 thousand, its row is displayed in Maroon colored text. Next technique demonstrates how to dynamically change the color of row in a DBGrid: procedure TForm1.DBGrid1DrawColumnCell (Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); begin if Table1.FieldByName('Salary').AsCurrency>36000 then DBGrid1.Canvas.Brush.Color:=clWhite; DBGrid1.DefaultDrawColumnCell (Rect, DataCol, Column, State); end; If an employee's salary is greater than 36 thousand, its row is displayed in White. Coloring Cells And finally: if you want to change the background color of the cells of the particular column (+ text foreground color), this is what you have to do: procedure TForm1.DBGrid1DrawColumnCell (Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); begin if Table1.FieldByName('Salary').AsCurrency>40000 then begin DBGrid1.Canvas.Font.Color:=clWhite; DBGrid1.Canvas.Brush.Color:=clBlack; end; if DataCol = 4 then //4 th column is 'Salary' DBGrid1.DefaultDrawColumnCell (Rect, DataCol, Column, State); end; If an employee's salary is greater than 40 thousand, its Salary cell is displayed in Black and text is displayed in White. Conclusion Techniques described in this article can really distinguish you from others, but be careful: too much coloring is too much... Now, when I look, there are far too much colors in these examples. How about graphics?

Setting Default Printer di Delphi

procedure SetDefaultPrinter(PrinterName: String) ;
var
___j: Integer;
___Device : PChar;
___Driver : Pchar;
___Port : Pchar;
___HdeviceMode: Thandle;
___aPrinter : TPrinter;
begin
___Printer.PrinterIndex := -1;
___getmem(Device, 255) ;
___getmem(Driver, 255) ;
___getmem(Port, 255) ;
___aPrinter := TPrinter.create;
___for j := 0 to Printer.printers.Count-1 do
___begin
______if Printer.printers[j] = PrinterName then
______begin___
_________aprinter.printerindex := i;
_________aPrinter.getprinter(device, driver, port, HdeviceMode) ;
_________StrCat(Device, ',') ;___
_________StrCat(Device, Driver ) ;
_________StrCat(Device, Port ) ;
_________WriteProfileString('windows', 'device', Device) ;
_________StrCopy( Device, 'windows' ) ;
_________SendMessage(HWND_BROADCAST, WM_WININICHANGE,0, Longint(@Device)) ;
______end;
___end;
___Freemem(Device, 255) ;
___Freemem(Driver, 255) ;
___Freemem(Port, 255) ;___
___aPrinter.Free;
end;

Change Printer Orientation Setup

You cannot change printer property during print document. But you can interrupt print process to change properties and run print again from the necessary line. uses Printers;
...
procedure TForm1.Button1Click(Sender: TObject) ;
var
___F, F2: TextFile;
___k, j: Integer;
begin
___AssignPrn(F) ;
___Rewrite(F) ;
___Writeln(F, RichEdit1.Lines[0]) ;
___for k:=1 to RichEdit1.Lines.Count-1 do
___begin
______if Printer.PageNumber<2>then
_________Writeln(F, RichEdit1.Lines[k]) ;
______if Printer.PageNumber>1 then
______begin
_________CloseFile(F) ;
_________Break;
______end;
___end;

___AssignPrn(F2) ;
___Printer.Orientation:=poLandscape;

___Rewrite(F2) ;
___for j:=i to RichEdit1.Lines.Count-1 do
______Writeln(F2, RichEdit1.Lines[j]) ;
___CloseFile(F2) ;
end;