Pemograman Delphi

Bagi anda yang ingin belajar pemograman delphi dan belum memiliki aplikasi DELPHI itu sendiri silahkan anda download di sini Borland Delphi 7 Enterprise dengan kapasitas  296 mb… Didalam kontent tersebut sudah tersedia crack dan serial number untuk aplikasi… Jadi jangan khawatir bakal sia – sia ngedonlotnya…

Setelah selesai donlot silahkan baca ato copi skalian beberapa tips dan source code dibawah buat latihan anda… Jika dari anda punya code-code lain yang mungkin bermanfaat ato sekedar masukkan silahkan posting ke dalam komentar… Biar kita semua semua sama – sama maju dan saling membantu…

MEMASUKKAN PROGRAM ANDA KEDALAM ADD REMOVE PROGRAM LIST

MEMASUKKAN PROGRAM ANDA KEDALAM ADD REMOVE PROGRAM LIST

uses Registry;

procedure TForm1.Button1Click(Sender: TObject);
var
  reg: TRegistry;
begin
  reg := TRegistry.Create;
  reg.RootKey := HKEY_LOCAL_MACHINE;
  reg.LazyWrite := false;
  reg.OpenKey(
    'SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\MyProgam',
    true);
  reg.WriteString('DisplayName', 'My Program');
  reg.WriteString('UninstallString',
   'C:\Program Files\Borland\Delphi 3\MyUninstall.exe UninstalMe');
  reg.CloseKey;
  reg.free;
end;

UNTUK MENGUNINSTAL PROGRAM TADI MAKA LISTING KODENYA ADALAH
SEBAGAI BERIKUT

uses Registry;

procedure TForm1.Button1Click(Sender: TObject);
var
  reg: TRegistry;
begin
  reg := TRegistry.Create;
  reg.RootKey := HKEY_LOCAL_MACHINE;
  reg.LazyWrite := false;
  reg.DeleteKey(
'SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\MyProgam');
  reg.free;
end;

MENDAFTARKAN TIPE FILE KEDALAM SYSTEM

MENDAFTARKAN TIPE FILE KEDALAM SYSTEM

uses registry, shlobj;

procedure TForm1.RegisterFileType(prefix:String; exepfad:String);
var
  reg:TRegistry;
begin
  reg:=TRegistry.Create;
  reg.RootKey:=HKEY_CLASSES_ROOT;
  //create a new key  --> .pci
  reg.OpenKey('.'+prefix,True);
  //create a new value for this key --> pcifile
  reg.WriteString('',prefix+'file');
  reg.CloseKey;
  //create a new key --> pcifile
  reg.CreateKey(prefix+'file');
  //create a new key pcifile\DefaultIcon
  reg.OpenKey(prefix+'file\DefaultIcon',True);
  //and create a value where the icon is stored --> c:\project1.exe,0
  reg.WriteString('',exepfad+',0');
  reg.CloseKey;
  reg.OpenKey(prefix+'file\shell\open\command',True);
  //create value where exefile is stored --> c:\project1.exe "%1"
  reg.WriteString('',exepfad+' "%1"');
  reg.CloseKey;
  reg.Free;
  SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  RegisterFileType('pci','c:\project1.exe');
end;

MENGGANTI DESKTOP WALLPAPER

MENGGANTI DESKTOP WALLPAPER

uses
  Registry, WinProcs;

procedure SetWallpaper(sWallpaperBMPPath : String; bTile : boolean);
var
  reg : TRegIniFile;
begin
  reg := TRegIniFile.Create('Control Panel\Desktop');
  with reg do
  begin
    WriteString('', 'Wallpaper', sWallpaperBMPPath);
    if(bTile)then
    begin
      WriteString('', 'TileWallpaper', '1');
    end else
    begin
      WriteString('', 'TileWallpaper', '0');
    end;
  end;
  reg.Free;
  SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, Nil, SPIF_SENDWININICHANGE);
end;

// 2. Way:

procedure TForm1.Button1Click(Sender: TObject);
type a=array [0..255] of char;
var filename: ^a;
begin
 new(filename);
 strpcopy(filename^,'c:\[WinDIR]\wall.bmp');
 dispose(filename);
 if SystemParametersInfo(SPI_SETDESKWALLPAPER,0,filename,SPIF_SENDCHANGE ) then showmessage('Succesful')
 else showmessage('something was wrong!');
end;

MENCEK LAMA PEMAKAIAN KOMPUTER

MENCEK LAMA PEMAKAIAN KOMPUTER

function UpTime: string;
const
  ticksperday : integer = 1000 * 60 * 60 * 24;
  ticksperhour : integer = 1000 * 60 * 60;
  ticksperminute : integer = 1000 * 60;
  tickspersecond : integer = 1000;

var
  t : longword;
  d, h, m, s : integer;

begin
  t := GetTickCount;

  d := t div ticksperday;
  dec(t, d * ticksperday);

  h := t div ticksperhour;
  dec(t, h * ticksperhour);

  m := t div ticksperminute;
  dec(t, m * ticksperminute);

  s := t div tickspersecond;

  Result := 'Uptime: '+IntToStr(d)+ ' Days '+IntToStr(h)+' Hours '+IntToStr(m)+' Minutes '+IntToStr(s)+' Seconds';
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  label1.Caption:=UpTime;
end;

MENGKLIK TOMBOL APLIKASI LAIN dari APLIKASI KITA

MENGKLIK TOMBOL DARI APLIKASI LAIN

function EnumChildProc(Wnd : hWnd; SL : TStrings) : Boolean; StdCall;
var
  szFull : Array[0..MAX_PATH] of char;
begin
  Result:=Wnd<>0;
  if Result then begin
    GetWindowText(Wnd, szFull, SizeOf(szFull));
    if (pos(SL[0],StrPas(szFull))>0) // Test for text
    and (SL.IndexOfObject(TOBject(Wnd))< 0)
    then SL.AddObject(StrPas(szFull),TObject(Wnd));
    EnumChildWindows(Wnd,@EnumChildProc, LongInt(SL));
  end;
end;

function ClickButton(ParentWindow : Hwnd; ButtonCaption : string) : boolean;
var
  SL:TStringList;
  H:hWnd;
begin
  SL:=TStringList.Create;
  try
    SL.AddObject(ButtonCaption, nil);
    EnumChildWindows(ParentWindow, @EnumChildProc, LongInt(SL));
    H:=0;
    case SL.Count of
      1: ShowMessage('Window text not found.');
      2: H := hWnd(SL.Objects[1]);
      else ShowMessage('Ambiguous text detected.');
    end;
  finally
    SL.Free;
  end;
  Result := H <> 0;
  if Result then PostMessage(H, BM_CLICK, 0, 0);
end;

MENAMPILKAN INFORMASI DARI SEBUAH FILE

MENAMPILKAN INFORMASI DARI SEBUAH FILE

procedure TForm1.Button1Click(Sender: TObject);
var
  MyS: TWin32FindData;
  FName: string;
  MyTime: TFileTime;
  MySysTime: TSystemTime;
begin
  Memo1.Clear;
  FName:=Edit1.Text;
  with Memo1.Lines do
  begin
    Add('Directory - '+ExtractFileDir(FName));
    Add('Drive - '+ExtractFileDrive(FName));
    Add('Extension - '+ExtractFileExt(FName));
    Add('File name - '+ExtractFileName(FName));
    Add('Path - '+ExtractFilePath(FName));
    Add('');

    FindFirstFile(PChar(FName), MyS);
    case MyS.dwFileAttributes of
      FILE_ATTRIBUTE_COMPRESSED: Add('Attribute - File is compressed');
      FILE_ATTRIBUTE_HIDDEN: Add('Attribute - File is hidden');
      FILE_ATTRIBUTE_NORMAL: Add('Attribute - File has no any attributes');
      FILE_ATTRIBUTE_READONLY: Add('Attribute - Read only file');
      FILE_ATTRIBUTE_SYSTEM: Add('Attribute - System file');
      FILE_ATTRIBUTE_TEMPORARY: Add('Attribute - File for temporary storage');
      FILE_ATTRIBUTE_ARCHIVE: Add('Attribute - Archive file');
    end;

    MyTime:=MyS.ftCreationTime;
    FileTimeToSystemTime(MyTime, MySysTime);
    Add(
      'Time Creation - '+
      IntToStr(MySysTime.wDay)+'.'+
      IntToStr(MySysTime.wMonth)+'.'+
      IntToStr(MySysTime.wYear)+'  '+
      IntToStr(MySysTime.wHour)+':'+
      IntToStr(MySysTime.wMinute));

    MyTime:=MyS.ftLastAccessTime;
    FileTimeToSystemTime(MyTime, MySysTime);
    Add(
      'Last time access - '+
      IntToStr(MySysTime.wDay)+'.'+
      IntToStr(MySysTime.wMonth)+'.'+
      IntToStr(MySysTime.wYear));

    Add('Size - '+IntToStr(MyS.nFileSizeLow));
    Add('Alternate name - '+StrPas(MyS.cAlternateFileName));
  end;
end;

MENGOMPRESS DAN UNCOMPRESS STREAM

MENGOMPRESS DAN UNCOMPRESS STREAM

Uses
  ZLib;

{ Compress stream }
procedure CompressStream(inpStream, outStream: TStream);
var
  InpBuf,OutBuf: Pointer;
  InpBytes,OutBytes: integer;
begin
  InpBuf := nil;
  OutBuf := nil;
  try
    GetMem(InpBuf,inpStream.size);
    inpStream.Position := 0;
    InpBytes := inpStream.Read(InpBuf^,inpStream.size);
    CompressBuf(InpBuf,InpBytes,OutBuf,OutBytes);
    outStream.Write(OutBuf^,OutBytes);
  finally
    if InpBuf <> nil then FreeMem(InpBuf);
    if OutBuf <> nil then FreeMem(OutBuf);
  end;
end;

{ Decompress stream }
procedure DecompressStream(inpStream, outStream: TStream);
var
  InpBuf,OutBuf: Pointer;
  OutBytes,sz: integer;
begin
  InpBuf := nil;
  OutBuf := nil;
  sz := inpStream.size-inpStream.Position;
  if sz > 0 then try
    GetMem(InpBuf,sz);
    inpStream.Read(InpBuf^,sz);
    DecompressBuf(InpBuf,sz,0,OutBuf,OutBytes);
    outStream.Write(OutBuf^,OutBytes);
  finally
    if InpBuf <> nil then FreeMem(InpBuf);
    if OutBuf <> nil then FreeMem(OutBuf);
  end;
  outStream.Position := 0;
end;

{
Contoh:
 Compress dan mengkalkulasikan compression rate.
 Kemudian simpakan kedalam file (ms2.dat)
}

procedure TForm1.Button1Click(Sender: TObject);
var
 ms1, ms2 : TMemoryStream;
begin
  ms1 := TMemoryStream.Create;
  try
    ms2 := TMemoryStream.Create;
    try
      RichEdit1.Lines.SaveToStream(ms1);
      CompressStream(ms1,ms2);
      ShowMessage(Format('Stream Compression Rate: %d %%',
                 [round(100 / ms1.Size * ms2.Size)]));
      ms2.SaveToFile('C:\ms2.dat');
    finally
      ms1.Free;
    end;
  finally
    ms2.Free;
  end;
end;

{
Load stream DARI sebuah file (ms2.dat)
dan decompresses kan.
kemudian loads Stream ke RichEdit1.
}

procedure TForm1.Button2Click(Sender: TObject);
var
  ms1, ms2 : TMemoryStream;
begin
  ms1 := TMemoryStream.Create;
  try
    ms2 := TMemoryStream.Create;
    try
      ms1.LoadFromFile('C:\ms2.dat');
      DecompressStream(ms1,ms2);
      RichEdit1.Lines.LoadFromStream(ms2);
    finally
      ms1.Free;
    end;
  finally
    ms2.Free;
  end;
end;