Friday, May 13, 2011

Membuat Internet Browser


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, Unit2, Unit3, ExtCtrls, ComCtrls, Sockets;

type
  TForm1 = class(TForm)
    MM: TMainMenu;
    File1: TMenuItem;
    NewTab1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    SB: TStatusBar;
    Timer1: TTimer;
    TC: TTcpClient;
    procedure NewTab1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.NewTab1Click(Sender: TObject);
begin
   TForm2.Create(Self);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   Application.Title := 'ZS Browser';
if not DirectoryExists(ExtractFilePath(Application.ExeName)+'Bookmarks') then
   CreateDir(ExtractFilePath(Application.ExeName)+'Bookmarks');
   EB;
   EM;
   EF;
   ET;
   SB.Panels[2].Text := TC.LocalHostAddr;
   SB.Panels[3].Text := TC.LocalHostName;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
   SB.Panels[0].Text := DateToStr(Date);
   SB.Panels[1].Text := TimeToStr(Time);
end;

end.

//---------------------------------------------------------------------->

{ Created By : Zephio
  URL :    http://amateur-guide.blogspot.com}
unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, OleCtrls, SHDocVw, StdActns, ActnList, ExtCtrls, StdCtrls,
  ComCtrls, Buttons, FileCtrl, ShellApi;

type
  TForm2 = class(TForm)
    WB: TWebBrowser;
    MM: TMainMenu;
    File1: TMenuItem;
    NewTab1: TMenuItem;
    Close1: TMenuItem;
    Exit1: TMenuItem;
    N1: TMenuItem;
    AL: TActionList;
    WindowClose1: TWindowClose;
    WindowCascade1: TWindowCascade;
    WindowTileHorizontal1: TWindowTileHorizontal;
    WindowTileVertical1: TWindowTileVertical;
    WindowMinimizeAll1: TWindowMinimizeAll;
    WindowArrange1: TWindowArrange;
    Windows1: TMenuItem;
    ile1: TMenuItem;
    Cascade1: TMenuItem;
    Arrange1: TMenuItem;
    MinimizeAll1: TMenuItem;
    ile21: TMenuItem;
    PIU: TPanel;
    CB: TComboBox;
    OnEnterUrl1: TAction;
    PBM: TPanel;
    SpeedButton1: TSpeedButton;
    PHBM: TPanel;
    PHBC: TPanel;
    Bookmarks1: TMenuItem;
    N2: TMenuItem;
    PAB: TPanel;
    FLB: TFileListBox;
    EAT: TEdit;
    EAU: TEdit;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    Panel1: TPanel;
    Panel2: TPanel;
    LH: TListBox;
    Panel4: TPanel;
    SpeedButton4: TSpeedButton;
    SpeedButton5: TSpeedButton;
    Panel3: TPanel;
    Panel5: TPanel;
    EGS: TEdit;
    SpeedButton7: TSpeedButton;
    SpeedButton6: TSpeedButton;
    SpeedButton8: TSpeedButton;
    SpeedButton9: TSpeedButton;
    SpeedButton10: TSpeedButton;
    View1: TMenuItem;
    Back1: TMenuItem;
    Forward1: TMenuItem;
    Reload1: TMenuItem;
    N3: TMenuItem;
    Stop1: TMenuItem;
    Info1: TMenuItem;
    Contact1: TMenuItem;
    Web1: TMenuItem;
    About1: TMenuItem;
    N4: TMenuItem;
    Open1: TMenuItem;
    OD: TOpenDialog;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure NewTab1Click(Sender: TObject);
    procedure OnEnterUrl1Execute(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure PHBMMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure PIUMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure LBMMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure PHBCMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Bookmarks1Click(Sender: TObject);
    procedure PHBCClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FLBDblClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FLBClick(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure EATClick(Sender: TObject);
    procedure EAUClick(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
    procedure LHDblClick(Sender: TObject);
    procedure SpeedButton7Click(Sender: TObject);
    procedure EGSClick(Sender: TObject);
    procedure WBStatusTextChange(Sender: TObject; const Text: WideString);
    procedure WBTitleChange(Sender: TObject; const Text: WideString);
    procedure SpeedButton6Click(Sender: TObject);
    procedure SpeedButton8Click(Sender: TObject);
    procedure SpeedButton9Click(Sender: TObject);
    procedure SpeedButton10Click(Sender: TObject);
    procedure LHClick(Sender: TObject);
    procedure Back1Click(Sender: TObject);
    procedure Forward1Click(Sender: TObject);
    procedure Reload1Click(Sender: TObject);
    procedure Stop1Click(Sender: TObject);
    procedure Contact1Click(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure Web1Click(Sender: TObject);
    procedure Open1Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure EUS(Sender: TObject);
    procedure EHS(Sender: TObject);
  end;

var
  Form2: TForm2;

implementation




uses Unit1;

{$R *.dfm}

procedure TForm2.EHS(Sender: TObject);
var
   SL : TStringList;
begin
   SL := TStringList.Create;
   SL.Add('http://amateur-guide.blogspot.com');
   SL.Add('http://myspace.com/zephio');
   SL.Add('http://facebook.com/zephio85');
   SL.Add('http://twitter.com/zephio');
   FLB.Directory := ExtractFilePath(Application.ExeName)+'BookMarks';
if not DirectoryExists(ExtractFilePath(Application.ExeName)+'History') then
   CreateDir(ExtractFilePath(Application.ExeName)+'History');
if not FileExists(ExtractFilePath(Application.ExeName)+'History\Log.his') then
   SL.SaveToFile(ExtractFilePath(Application.ExeName)+'History\Log.his');
   SL.Free;
end;

procedure TForm2.EUS(Sender: TObject);
begin
if CB.Text = '' then
   Exit
else
   WB.Navigate(CB.Text);
   EHS(Self);
   CB.Items.Add(CB.Text);
   CB.Items.SaveToFile(ExtractFilePath(Application.ExeName)+'History\Log.his');
   LH.Clear;
   LH.Items.LoadFromFile(ExtractFilePath(Application.ExeName)+'History\Log.his');
end;

procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   Action := CaFree;
end;

procedure TForm2.NewTab1Click(Sender: TObject);
begin
   Form1.NewTab1Click(Self);
end;

procedure TForm2.OnEnterUrl1Execute(Sender: TObject);
begin
   EUS(Self);
end;

procedure TForm2.SpeedButton1Click(Sender: TObject);
begin
   EUS(Self);
end;

procedure TForm2.PHBMMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
   PHBC.Font.Color := ClBlack;
end;

procedure TForm2.PIUMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
   PAB.Font.Color := ClBlack;
end;

procedure TForm2.LBMMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
   PIU.Font.Color := ClBlack;
end;

procedure TForm2.PHBCMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
   PHBC.Font.Color := ClRed;
end;

procedure TForm2.Bookmarks1Click(Sender: TObject);
begin
   PBM.Visible := not PBM.Visible;
   Bookmarks1.Checked := not Bookmarks1.Checked;
end;

procedure TForm2.PHBCClick(Sender: TObject);
begin
   Bookmarks1Click(Self);
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
   EHS(Self);
   CB.Items.LoadFromFile(ExtractFilePath(Application.ExeName)+'History\Log.his');
   LH.Items.LoadFromFile(ExtractFilePath(Application.ExeName)+'History\Log.his');
end;

procedure TForm2.FLBDblClick(Sender: TObject);
var
   SL : TStringList;
begin
   SL := TStringList.Create;
if not FileExists(ExtractFilePath(Application.ExeName)+'Bookmarks\'+FLB.Items[FLB.ItemIndex]) then
   Exit;
   SL.LoadFromFile(FLB.Items[FLB.ItemIndex]);
   CB.Text := Copy(SL.Strings[1], 5, Length(SL.Strings[1]));
   EUS(Self);
   SL.Free;
end;

procedure TForm2.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
   LH.Items.SaveToFile(ExtractFilePath(Application.ExeName)+'History\Log.his');
end;

procedure TForm2.FLBClick(Sender: TObject);
begin
   FLB.Hint := 'Visit '+ChangeFileExt(FLB.Items[FLB.ItemIndex],'');
end;

procedure TForm2.SpeedButton2Click(Sender: TObject);
var
   SL : TStringList;
begin
   SL := TStringList.Create;
if (EAU.Text = '') or
   (EAU.Text = 'Enter URL Here') then
   Exit
else
   SL.Add('[InternetShortcut]');
   SL.Add('URL='+EAU.Text);
   SL.SaveToFile(ExtractFilePath(Application.ExeName)+'Bookmarks\'+EAT.Text+'.url');
   SL.Free;
   EAT.Text := 'Untitled';
   EAT.Font.Color := ClGray;
   EAU.Text := 'Enter URL Here';
   EAU.Font.Color := ClGray;
   FLB.Directory := ExtractFilePath(Application.ExeName)+'BookMarks';
end;

procedure TForm2.EATClick(Sender: TObject);
begin
if EAT.Text <> 'Untitled' then
   Exit
else
   EAT.Clear;
   EAT.Font.Color := CLBlack;
end;

procedure TForm2.EAUClick(Sender: TObject);
begin
if EAU.Text <> 'Enter URL Here' then
   Exit
else
   EAU.Clear;
   EAU.Font.Color := CLBlack;
end;

procedure TForm2.SpeedButton3Click(Sender: TObject);
begin
if {(FLB.Selected[FLB.ItemIndex] = false) or }
   (FLB.Count = 0) then
   Exit
else
   DeleteFile(ExtractFilePath(Application.ExeName)+'BookMarks\'+FLB.Items[FLB.ItemIndex]);
if FLB.ItemIndex >= 0 then
     FLB.Items.Delete(FLB.ItemIndex);
   FLB.Directory := ExtractFilePath(Application.ExeName)+'BookMarks';
end;

procedure TForm2.SpeedButton4Click(Sender: TObject);
begin
if LH.ItemIndex >= 0 then
     LH.Items.Delete(LH.ItemIndex);
   LH.Items.SaveToFile(ExtractFilePath(Application.ExeName)+'History\Log.his');
end;

procedure TForm2.SpeedButton5Click(Sender: TObject);
var
   S : String;
begin
   S := Copy(CB.Text, 0, Length(CB.Text));
   LH.Clear;
   CB.Clear;
   DeleteFile(ExtractFilePath(Application.ExeName)+'History\Log.his');
   LH.Items.SaveToFile(ExtractFilePath(Application.ExeName)+'History\Log.his');
   CB.Text := S;
end;

procedure TForm2.LHDblClick(Sender: TObject);
begin
if LH.Count = 0 then
   Exit
else
   CB.Text := LH.Items[LH.ItemIndex];
   EUS(Self);
end;

procedure TForm2.SpeedButton7Click(Sender: TObject);
begin
if (EGS.Text = '') or
   (EGS.Text = 'Google Search Engine') then
   Exit
else
   CB.Text := 'http://www.google.com/search?q='+EGS.Text+'&num=10&ie=utf-8';
   EUS(Self);
end;

procedure TForm2.EGSClick(Sender: TObject);
begin
if EGS.Text <> 'Google Search Engine' then
   Exit
else
   EGS.Clear;
   EGS.Font.Color := CLBlack;
end;

procedure TForm2.WBStatusTextChange(Sender: TObject;
  const Text: WideString);
begin
   Form1.SB.Panels[4].Text := WB.LocationURL;
end;

procedure TForm2.WBTitleChange(Sender: TObject; const Text: WideString);
begin
   Caption := WB.LocationName;
end;

procedure TForm2.SpeedButton6Click(Sender: TObject);
begin
    WB.GoBack;
end;

procedure TForm2.SpeedButton8Click(Sender: TObject);
begin
   WB.GoForward;
end;

procedure TForm2.SpeedButton9Click(Sender: TObject);
begin
   EUS(Self);
end;

procedure TForm2.SpeedButton10Click(Sender: TObject);
begin
   WB.Stop;
end;

procedure TForm2.LHClick(Sender: TObject);
begin
   LH.Hint := LH.Items[LH.ItemIndex];
end;

procedure TForm2.Back1Click(Sender: TObject);
begin
   WB.GoBack;
end;

procedure TForm2.Forward1Click(Sender: TObject);
begin
   WB.GoForward;
end;

procedure TForm2.Reload1Click(Sender: TObject);
begin
   EUS(Self);
end;

procedure TForm2.Stop1Click(Sender: TObject);
begin
   WB.Stop;
end;

procedure TForm2.Contact1Click(Sender: TObject);
begin
   ShellExecute(0,'open','mailto:zephio@myspace.com?subject=Hi, Zephio...','','',SW_SHOW);
end;

procedure TForm2.About1Click(Sender: TObject);
begin
   ShowMessage('~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'+#13+
               'Apps Name : ZS Browser'+#13+
               'Apps Type : Internet Browser'+#13+
               'Platform : Win XP'+#13+
               'Created By : Zephio'+#13+
               'URL : http://amateur-guide.blogspot.com'+#13+
               '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~');
end;

procedure TForm2.Web1Click(Sender: TObject);
begin
   WB.Navigate('http://amateur-guide.blogspot.com');
end;

procedure TForm2.Open1Click(Sender: TObject);
begin
if not OD.Execute then
   Exit;
   CB.Text := OD.FileName;
   EUS(Self);
end;

procedure TForm2.Exit1Click(Sender: TObject);
begin
   Application.Terminate;
end;

end.


//---------------------------------------------------------------------->

unit Unit3;

interface


uses
   Forms, SysUtils, Classes;

procedure EB;
procedure EM;
procedure EF;
procedure ET;


implementation

procedure EB;
var
   SL : TStringList;
begin
   SL := TStringList.Create;
   SL.Add('[InternetShortcut]');
   SL.Add('URL=http://amateur-guide.blogspot.com');
   SL.SaveToFile(ExtractFilePath(Application.ExeName)+'Bookmarks\Blog Spot.url');
   SL.Free;
end;

procedure EM;
var
   SL : TStringList;
begin
   SL := TStringList.Create;
   SL.Add('[InternetShortcut]');
   SL.Add('URL=http://myspace.com/zephio');
   SL.SaveToFile(ExtractFilePath(Application.ExeName)+'Bookmarks\My Space.url');
   SL.Free;
end;

procedure EF;
var
   SL : TStringList;
begin
   SL := TStringList.Create;
   SL.Add('[InternetShortcut]');
   SL.Add('URL=http://facebook.com/zephio85');
   SL.SaveToFile(ExtractFilePath(Application.ExeName)+'Bookmarks\Face Book.url');
   SL.Free;
end;

procedure ET;
var
   SL : TStringList;
begin
   SL := TStringList.Create;
   SL.Add('[InternetShortcut]');
   SL.Add('URL=http://twitter.com/zephio');
   SL.SaveToFile(ExtractFilePath(Application.ExeName)+'Bookmarks\Twitter.url');
   SL.Free;
end;

end.
DL SC : http://www.mediafire.com/?c859v61ajfksj5e
Posted by at
Labels:

No comments:

Post a Comment

Subscribe to: Post Comments (Atom)