Explore Folder

function ExploreFolder(const Folder: string): Boolean;

begin

if SysUtils.FileGetAttr(Folder) and faDirectory = faDirectory then

// Folder is valid directory: try to explore it

Result := ShellAPI.ShellExecute(

0, 'explore', PChar(Folder), nil, nil, Windows.SW_SHOWNORMAL

) > 32

else

// Folder is not a directory: error

Result := False;

end;

Open Folder

function OpenFolder(const Folder: string): Boolean;

begin

if SysUtils.FileGetAttr(Folder) and faDirectory = faDirectory then

// Folder is valid directory: try to open it

Result := ShellAPI.ShellExecute(

0, 'open', PChar(Folder), nil, nil, Windows.SW_SHOWNORMAL

) > 32

else

// Folder is not a directory: error

Result := False;

end;

Open Folder

Uses ShellAPI, Windows, SysUtils;

function OpenFolder(const Folder: string): Boolean;

begin

if SysUtils.FileGetAttr(Folder) and faDirectory = faDirectory then

Result := ShellAPI.ShellExecute(

0, 'open', PChar(Folder), nil, nil, Windows.SW_SHOWNORMAL) > 32

else

Result := False;

end;

Deteksi Nama dan Volume Serial Drive

Souce Code

unit Unit1;

interface

uses

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

Dialogs, StdCtrls;

type

TForm1 = class(TForm)

Button1: TButton;

Edit1: TEdit;

Edit2: TEdit;

Label1: TLabel;

Label2: TLabel;

Edit3: TEdit;

Label3: TLabel;

Label4: TLabel;

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

VAR lDBPathName: STRING;

VolumeName, FileSystemName: array[0..MAX_PATH - 1] of Char;

VolumeSerialNo: DWord;

MaxComponentLength, FileSystemFlags: cardinal;

a: integer;

b : pansichar;

s:string;

begin

b:=PChar(edit3.Text);

GetVolumeInformation(b, VolumeName, MAX_PATH, @VolumeSerialNo, MaxComponentLength, FileSystemFlags, FileSystemName, MAX_PATH);

edit1.Text:=VolumeName;

edit2.Text:=IntToHex(VolumeSerialNo, 8);

end;

end.

Menjalankan Aplikasi Lewat Delphi

Untuk menjalankan aplikasi atau mengeksekusi file dalam lingkungan Win32 dalam delphi kita bisa menggunakan fungsi API Windows ShellExecute.

contoh dibawah ini potong program penggunaan fungsi ShellExecute.

uses ShellApi;

.......................

// Menjalankan Aplikasi Notepad Windows

ShellExecute( Handle, 'open', 'c:\windows\notepad.exe', nil, nil, SW_SHOWNORMAL );

// Menjalankan Aplikasi Notepad Windows dan membuka file readme.txt

ShellExecute( Handle, 'open', 'c:\windows\notepad.exe', 'c:\readme.txt', nil, SW_SHOWNORMAL );

// Membuka Folder Download C:\Download folder

ShellExecute( Handle, 'open', 'c:\download', nil, nil, SW_SHOWNORMAL );

// Membuka File Microsoft Word

ShellExecute( Handle, 'open', 'c:\docs\coba.doc', nil, nil, SW_SHOWNORMAL );

// Membuka Alamat Web

ShellExecute( Handle, 'open', 'http://www.freeiklamu.blogspot.com', nil, nil, SW_SHOWNORMAL );

...................

Timming Expire Demo Program

Procedure TForm1.FormShow(Sender: TObject);
var
YY, MM, DD : Integer;
begin
YY := 2007;
MM := 9;
DD := 1;

if (Date >= EncodeDate(YY, DD, MM)) then
begin
ShowMessage(‘Sory Program expire’);
Close;
end;
end;

Rename Directory

Procedure TForm1.BtnSelectClick(Sender: TObject);
var DirTemp: string;
begin
DirTemp:=GetCurrentDir;
if SelectDirectory(DirTemp, [], 1000) then
begin
Panel1.Caption := DirTemp;
Edit1.Text := DirTemp;
end;
end;

Procedure TForm1.BtnRenameClick(Sender: TObject);
begin
if DirectoryExists(Panel1.Caption) then
begin
RenameFile(Panel1.Caption, Edit1.Text);
Panel1.Caption := Edit1.Text;
end;
end;

Rename File

unit Unit1;

interface

uses

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

Dialogs, StdCtrls;

type

TForm1 = class(TForm)

Button1: TButton;

Edit1: TEdit;

Edit2: TEdit;

Label1: TLabel;

Label2: TLabel;

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

var

oldName, newName : string;

begin

// Try to rename the current Unit1.dcu to Uni1.old

oldName := Edit1.Text;

newName := edit2.Text;

if RenameFile(oldName, newName)

then ShowMessage(Edit1.Text+' renamed OK')

else ShowMessage(Edit1.Text+' rename failed with error : '+

IntToStr(GetLastError));

end;

end.

Delete File

unit Unit1;

interface

uses

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

Dialogs, StdCtrls;

type

TForm1 = class(TForm)

Button1: TButton;

Edit1: TEdit;

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

var

fileName : string;

myFile : TextFile;

data : string;

begin

// Try to open a text file for writing to

fileName := edit1.text ;

AssignFile(myFile, fileName);

ReWrite(myFile);

// Write to the file

Write(myFile, 'Hello World');

// Close the file

CloseFile(myFile);

// Reopen the file in read mode

Reset(myFile);

// Display the file contents

while not Eof(myFile) do

begin

ReadLn(myFile, data);

ShowMessage(data);

end;

// Close the file for the last time

CloseFile(myFile);

// Now delete the file

if DeleteFile(fileName)

then ShowMessage(fileName+' deleted OK')

else ShowMessage(fileName+' not deleted');

end;

end.

Copy File in Delphi

unit Unit1;

interface

uses

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

Dialogs, StdCtrls;

type

TForm1 = class(TForm)

Edit1: TEdit;

Edit2: TEdit;

Button1: TButton;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Label4: TLabel;

Button2: TButton;

procedure Button1Click(Sender: TObject);

procedure CopyFile(Src, Dst : String);

procedure Button2Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

var Source, Dest : String;

begin

CopyFile(edit1.Text, edit2.Text);

end;

procedure TForm1.CopyFile(Src, Dst : String);

var Fs : File Of Byte; // filehandle source

Fd : File of Byte; // filehandle dest

Buffer : Byte;

begin

if FileExists(edit1.Text) then

Begin

AssignFile(fs, edit1.Text); // set handle file Src

{$I-}

Reset(Fs); // baca file source

{$I+}

// {$I-} berfungsi untuk mengeset operasi file readonly

// {$I+} berfungsi untuk mengeset operasi file readwrite

AssignFile(fd, edit2.Text); // set handle file Dest

Rewrite(Fd); // tulis ulang file dest

While not EOF(Fs) do

Begin

Read(fs, buffer); // baca file source (per byte)

write(fd, buffer); // tulis file dest (per byte)

end;

CloseFile(fd);

CloseFile(fs);

end

else Writeln('File source tidak ditemukan'); // kalo file belum ada tulis ulang

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

form1.Close;

end;

end.

Autohide Taskbar

function IsTaskbarAutoHideOn : boolean;
var
ABData : TAppBarData;
begin
ABData.cbSize := sizeof(ABData);
Result :=
(SHAppBarMessage(ABM_GETSTATE, ABData)
and ABS_AUTOHIDE) > 0;
end;