unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, jpeg, OleCtrls, SHDocVw, StdCtrls, XPMan, MSHTML, ComCtrls,
Menus, inifiles, ShellAPI,
ActiveX;
type
TForm1 =
class(TForm)
Panel1: TPanel;
Image1: TImage;
WebBrowser1: TWebBrowser;
Edit1: TEdit;
Panel2: TPanel;
XPManifest1: TXPManifest;
StatusBar1: TStatusBar;
Image2: TImage;
Image3: TImage;
Timer1: TTimer;
MainMenu1: TMainMenu;
Datei1: TMenuItem;
Bearbeiten1: TMenuItem;
Asnicht1: TMenuItem;
Favoriten1: TMenuItem;
Extras1: TMenuItem;
N1: TMenuItem;
N2: TMenuItem;
Einstellungen1: TMenuItem;
N3: TMenuItem;
Einklappen1: TMenuItem;
Download1: TMenuItem;
About1: TMenuItem;
Image4: TImage;
Image5: TImage;
N4: TMenuItem;
Beenden1: TMenuItem;
Updates1: TMenuItem;
Hinzufgen1: TMenuItem;
ffnen1: TMenuItem;
Entfernen1: TMenuItem;
N5: TMenuItem;
HideTaskleiste1: TMenuItem;
procedure FormDestroy(Sender: TObject);
procedure Edit1DblClick(Sender: TObject);
procedure Entfernen1Click(Sender: TObject);
procedure ffnen1Click(Sender: TObject);
procedure Hinzufgen1Click(Sender: TObject);
procedure Updates1Click(Sender: TObject);
procedure Beenden1Click(Sender: TObject);
procedure Image5Click(Sender: TObject);
procedure Image4Click(Sender: TObject);
procedure WebBrowser1NavigateError(ASender: TObject;
const pDisp: IDispatch;
var URL, Frame, StatusCode: OleVariant;
var Cancel: WordBool);
procedure About1Click(Sender: TObject);
procedure Image3Click(Sender: TObject);
procedure Image2Click(Sender: TObject);
procedure Einklappen1Click(Sender: TObject);
procedure Einstellungen1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure WebBrowser1DocumentComplete(ASender: TObject;
const pDisp: IDispatch;
var URL: OleVariant);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure WebBrowser1NewWindow2(ASender: TObject;
var ppDisp: IDispatch;
var Cancel: WordBool);
procedure Panel4MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);
procedure Panel2Click(Sender: TObject);
procedure Edit1KeyPress(Sender: TObject;
var Key: Char);
procedure HideTaskleiste1Click(Sender: TObject);
private
hi:bool;
hi2:bool;
counter:integer;
ExtParam:bool;
FOleInPlaceActiveObject: IOleInPlaceActiveObject;
procedure MsgHandler(
var Msg: TMsg;
var Handled: Boolean);
public
ini:TIniFile;
version:
string;
PStatus:
String;
Serial:
string;
VPL:
String;
end;
var
Form1: TForm1;
implementation
uses About, Favoriten;
{$R *.dfm}
procedure TForm1.MsgHandler(
var Msg: TMsg;
var Handled: Boolean);
const
StdKeys = [VK_BACK, VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT];
var IOIPAO: IOleInPlaceActiveObject;
Dispatch: IDispatch;
begin
if WebBrowser1 =
nil then
begin
Handled := False;
Exit;
end;
Handled := (IsDialogMessage(WebBrowser1.Handle, Msg) = True);
if (Handled)
and (
not WebBrowser1.Busy)
then
begin
if FOleInPlaceActiveObject =
nil then
begin
Dispatch := WebBrowser1.Application;
if Dispatch <>
nil then
begin
Dispatch.QueryInterface(IOleInPlaceActiveObject, IOIPAO);
if IOIPAO <>
nil then FOleInPlaceActiveObject := IOIPAO;
end;
end;
if FOleInPlaceActiveObject <>
nil then
if ((Msg.
message = WM_KEYDOWN)
or (Msg.
message = WM_KEYUP))
and
(Msg.wParam
in StdKeys)
then
//nothing - do not pass on Backspace, Left, Right, Up, Down arrows
else FOleInPlaceActiveObject.TranslateAccelerator(Msg);
end;
end;
procedure startup();
begin
if Form1.extparam = false
then begin
Form1.ini:=TIniFile.create(ExtractFilePath(ParamStr(0))+'
siexdata.six');
Form1.ini.ReadString('
Main','
sid','
freeshare.ath.cx');
Form1.ini.Free;
end;
end;
procedure navigate(
URL:
String);
begin
Form1.WebBrowser1.Navigate(
URL);
end;
procedure TForm1.About1Click(Sender: TObject);
begin
Form5.Showmodal;
end;
procedure TForm1.Beenden1Click(Sender: TObject);
begin
Close;
end;
procedure TForm1.Edit1DblClick(Sender: TObject);
begin
Edit1.SelectAll;
end;
procedure TForm1.Edit1KeyPress(Sender: TObject;
var Key: Char);
begin
if Key = #13
then begin
key := #0;
navigate(Edit1.Text);
end;
end;
procedure TForm1.Einklappen1Click(Sender: TObject);
begin
Panel1.Top := 0;
Panel1.Left := 0;
Panel1.Anchors := [akLeft,akTop,akRight];
Panel1.Width := Form1.Width -8;
Image1.Width := Form1.Width -8;
hi := false;
hi2 := false;
Webbrowser1.SetFocus;
end;
procedure TForm1.Einstellungen1Click(Sender: TObject);
var
sid:
String;
begin
ini:=TIniFile.create(ExtractFilePath(ParamStr(0))+'
siexdata.six');
sid := ini.ReadString('
Main',sid,'
freeshare.ath.cx');
ini.Free;
ShellExecute(
Handle,'
open', '
siexse.exe',pchar(sid),
nil, SW_SHOWdefault) ;
end;
procedure TForm1.Entfernen1Click(Sender: TObject);
var
pos:integer;
begin
pos := Form4.ListBox1.Items.IndexOf(Webbrowser1.LocationURL);
if pos > -1
then Form4.ListBox1.Items.Delete(pos);
end;
procedure TForm1.ffnen1Click(Sender: TObject);
begin
Form4.Show;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnMessage := MsgHandler;
if paramstr(1) = '
'
then begin
Webbrowser1.Navigate('
siexnet.com');
extparam := true;
end
else
Webbrowser1.Navigate(paramstr(1));
///////////////Minimiert Starten///////////
{
Panel1.Top := -58;
Webbrowser1.Height := Webbrowser1.Height + 60;
Webbrowser1.Top := Webbrowser1.Top -59;
}
////////////////////////////////////////////
panel1.DoubleBuffered := true;
Webbrowser1.DoubleBuffered := true;
hi := true;
///////////////Bei Minimiert Start müssen beide False sein!!!!!
hi2 := false;
////////////////////////////////VersionsInformations/////////////////
PStatus := ('
Beta');
Version := ('
0.0.1.9');
VPL := '
0019';
/////////////////////////////////////////////////////////////////////
startup();
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FOleInPlaceActiveObject :=
nil;
end;
procedure TForm1.HideTaskleiste1Click(Sender: TObject);
begin
ShowWindow( Application.Handle, SW_HIDE );
SetWindowLong( Application.Handle, GWL_EXSTYLE,
GetWindowLong(Application.Handle, GWL_EXSTYLE)
or
WS_EX_TOOLWINDOW
and not WS_EX_APPWINDOW);
ShowWindow( Application.Handle, SW_SHOW );
end;
procedure TForm1.Hinzufgen1Click(Sender: TObject);
begin
Favoriten.Form4.Add := True;
Form4.URL := Webbrowser1.LocationURL;
Form4.Show;
end;
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
if Sender
is TImage
then
TWinControl(TImage(Sender).Parent).Perform(WM_SYSCOMMAND, $F012, 0)
else
TWinControl(Sender).Perform(WM_SYSCOMMAND, $F012, 0);
Panel1.Anchors := [akLeft,akTop];
Panel1.Width := 585;
Webbrowser1.Top := 0;
if hi2 = false
then begin
Webbrowser1.Height := Webbrowser1.Height + 59;
hi2 := true;
Webbrowser1.SetFocus;
end;
end;
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if hi = false
then begin
webbrowser1.Top := 60;
webbrowser1.Height := Webbrowser1.Height - 59;
Panel1.Top := 0;
hi := true;
end;
end;
procedure TForm1.Image2Click(Sender: TObject);
begin
try
Webbrowser1.GoBack;
except
end;
end;
procedure TForm1.Image3Click(Sender: TObject);
begin
try
Webbrowser1.GoForward;
except
end;
end;
procedure TForm1.Image4Click(Sender: TObject);
begin
Webbrowser1.Refresh;
end;
procedure TForm1.Image5Click(Sender: TObject);
begin
Webbrowser1.Stop;
end;
procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
// Mausereignisse abfangen
ReleaseCapture;
// mit TWinCotrol verschieben, $F012 verschiebt den Button
TWinControl(Sender).Perform(WM_SYSCOMMAND, $F012, 0);
Panel1.Anchors := [akLeft,akTop];
Panel1.Width := 585;
Webbrowser1.Top := 0;
if hi2 = false
then begin
Webbrowser1.Height := Webbrowser1.Height + 60;
hi2 := true;
Webbrowser1.SetFocus;
end;
end;
procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if hi = false
then begin
webbrowser1.Top := 60;
webbrowser1.Height := Webbrowser1.Height - 59;
Panel1.Top := 0;
hi := true;
end;
end;
procedure TForm1.Panel2Click(Sender: TObject);
begin
navigate(Edit1.Text);
end;
procedure TForm1.Panel4MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
// Mausereignisse abfangen
ReleaseCapture;
// mit TWinCotrol verschieben, $F012 verschiebt den Button
TWinControl(Sender).Perform(WM_SYSCOMMAND, $F012, 0);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
counter := counter +1;
end;
procedure TForm1.Updates1Click(Sender: TObject);
begin
ShellExecute(
Handle,'
open', '
siexup.exe',pchar(version+'
'+PStatus+'
- '+VPL),
nil, SW_SHOWdefault) ;
end;
procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject;
const pDisp: IDispatch;
var URL: OleVariant);
begin
Application.Title := '
SIEX - ' + Form1.WebBrowser1.LocationName;
Form1.Caption := '
SIEX - ' + Form1.WebBrowser1.LocationName;
Edit1.Text := Webbrowser1.LocationURL;
end;
procedure TForm1.WebBrowser1NavigateError(ASender: TObject;
const pDisp: IDispatch;
var URL, Frame, StatusCode: OleVariant;
var Cancel: WordBool);
begin
Navigate('
file:///'+ExtractFilePath(ParamStr(0))+'
data/404.html');
end;
procedure TForm1.WebBrowser1NewWindow2(ASender: TObject;
var ppDisp: IDispatch;
var Cancel: WordBool);
var
NewWindow: TForm1;
begin
//
{
if cancel=false then
begin
NewWindow:=TForm1.Create(self);
URL:=((TWebbrowser(ASender).document as IHTMLDocument2).activeElement as IHTMLElement).getAttribute('href', 0);
NewWindow.Show;
NewWindow.webbrowser1.Navigate(url);
end;
}
//NewWindow := ShellExecute(Handle,'open', 'SIEX.exe',Webbrowser1, nil, SW_SHOWdefault);
NewWindow := Form1.Create(Self);
NewWindow.Show;
ppDisp := NewWindow.webbrowser1.DefaultDispatch;
ppDisp:=WebBrowser1.Application;
end;
initialization
OleInitialize(
nil);
finalization
OleUninitialize
end.