Bawię się ze żródełkami przeglądarki internetowej z przykładów delphi i wszystko było ok. Po jakim miesiącu powróciłe, żeby znowu trochę poedytować ten pliczek i nagle nie wiadomo skąd program po uruchomieniu wywala błąd! Kiedy chce wejść na jaką kolwiek stronę pisze "cces violation at address 004724EE in module 'webbrows.exe'. Read of address 00000398.". Nie mam pojęcia co może powodować ten błąd. Oto kod programu:
unit Main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Menus, ComCtrls, OleCtrls, Buttons, ToolWin,
ActnList, ImgList,SHDocVw_TLB;
const
CM_HOMEPAGEREQUEST = WM_USER + $1000;
type
TMainForm = class(TForm)
StatusBar1: TStatusBar;
MainMenu1: TMainMenu;
File1: TMenuItem;
Exit1: TMenuItem;
View1: TMenuItem;
NavigatorImages: TImageList;
NavigatorHotImages: TImageList;
LinksImages: TImageList;
LinksHotImages: TImageList;
CoolBar1: TCoolBar;
ToolBar1: TToolBar;
BackBtn: TToolButton;
ForwardBtn: TToolButton;
StopBtn: TToolButton;
RefreshBtn: TToolButton;
ToolBar2: TToolBar;
ToolButton6: TToolButton;
ToolButton5: TToolButton;
ToolButton7: TToolButton;
ToolButton8: TToolButton;
URLs: TComboBox;
Help1: TMenuItem;
About1: TMenuItem;
Toolbar3: TMenuItem;
Statusbar2: TMenuItem;
Go1: TMenuItem;
Back1: TMenuItem;
Forward1: TMenuItem;
Stop1: TMenuItem;
Refresh1: TMenuItem;
ActionList1: TActionList;
BackAction: TAction;
ForwardAction: TAction;
StopAction: TAction;
RefreshAction: TAction;
WebBrowser1: TWebBrowser;
ProgressBar1: TProgressBar;
ToolButton1: TToolButton;
ListBox1: TListBox;
procedure Exit1Click(Sender: TObject);
procedure About1Click(Sender: TObject);
procedure StopClick(Sender: TObject);
procedure URLsKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormCreate(Sender: TObject);
procedure LinksClick(Sender: TObject);
procedure RefreshClick(Sender: TObject);
procedure BackClick(Sender: TObject);
procedure ForwardClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure URLsClick(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure Toolbar3Click(Sender: TObject);
procedure Statusbar2Click(Sender: TObject);
procedure BackActionUpdate(Sender: TObject);
procedure ForwardActionUpdate(Sender: TObject);
procedure WebBrowser1BeforeNavigate2(Sender: TObject;
const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
Headers: OleVariant; var Cancel: WordBool);
procedure WebBrowser1DownloadBegin(Sender: TObject);
procedure WebBrowser1DownloadComplete(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormActivate(Sender: TObject);
procedure WebBrowser1ProgressChange(ASender: TObject; Progress,
ProgressMax: Integer);
procedure WebBrowser1NewWindow2(ASender: TObject;
var ppDisp: IDispatch; var Cancel: WordBool);
procedure WebBrowser1Enter(Sender: TObject);
procedure WebBrowser1DocumentComplete(ASender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
private
HistoryIndex: Integer;
HistoryList: TStringList;
UpdateCombo: Boolean;
procedure FindAddress;
procedure HomePageRequest(var message: tmessage); message CM_HOMEPAGEREQUEST;
end;
var
MainForm: TMainForm;
implementation
uses About;
{$R *.DFM}
procedure TMainForm.Exit1Click(Sender: TObject);
begin
Close;
end;
procedure TMainForm.FindAddress;
var
Flags: OLEVariant;
begin
Flags := 0;
UpdateCombo := True;
WebBrowser1.Navigate(WideString(Urls.Text), Flags, Flags, Flags, Flags);
end;
procedure TMainForm.About1Click(Sender: TObject);
begin
ShowAboutBox;
end;
procedure TMainForm.StopClick(Sender: TObject);
begin
WebBrowser1.Stop;
end;
procedure TMainForm.URLsKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key = VK_Return then
begin
FindAddress;
end;
end;
procedure TMainForm.URLsClick(Sender: TObject);
begin
FindAddress;
end;
procedure TMainForm.LinksClick(Sender: TObject);
begin
if (Sender as TToolButton).Hint = '' then Exit;
URLs.Text := (Sender as TToolButton).Hint;
FindAddress;
end;
procedure TMainForm.RefreshClick(Sender: TObject);
begin
FindAddress;
end;
procedure TMainForm.BackClick(Sender: TObject);
begin
URLs.Text := HistoryList[HistoryIndex - 1];
FindAddress;
end;
procedure TMainForm.ForwardClick(Sender: TObject);
begin
URLs.Text := HistoryList[HistoryIndex + 1];
FindAddress;
end;
procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Shift = [ssAlt] then
if (Key = VK_RIGHT) and ForwardBtn.Enabled then
ForwardBtn.Click
else if (Key = VK_LEFT) and BackBtn.Enabled then
BackBtn.Click;
end;
procedure TMainForm.Toolbar3Click(Sender: TObject);
begin
with Sender as TMenuItem do
begin
Checked := not Checked;
Coolbar1.Visible := Checked;
end;
end;
procedure TMainForm.Statusbar2Click(Sender: TObject);
begin
with Sender as TMenuItem do
begin
Checked := not Checked;
StatusBar1.Visible := Checked;
end;
end;
procedure TMainForm.HomePageRequest(var Message: TMessage);
begin
URLs.Text := 'http://www.google.pl';
FindAddress;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
HistoryIndex := -1;
HistoryList := TStringList.Create;
{ Load the animation from the AVI file in the startup directory. An
alternative to this would be to create a .RES file including the cool.avi
as an AVI resource and use the ResName or ResId properties of Animate1 to
point to it. }
{ Find the home page - needs to be posted because HTML control hasn't been
registered yet. }
PostMessage(Handle, CM_HOMEPAGEREQUEST, 0, 0);
end;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
HistoryList.Free;
end;
procedure TMainForm.BackActionUpdate(Sender: TObject);
begin
if HistoryList.Count > 0 then
BackAction.Enabled := HistoryIndex > 0
else
BackAction.Enabled := False;
end;
procedure TMainForm.ForwardActionUpdate(Sender: TObject);
begin
if HistoryList.Count > 0 then
ForwardAction.Enabled := HistoryIndex < HistoryList.Count - 1
else
ForwardAction.Enabled := False;
end;
procedure TMainForm.WebBrowser1BeforeNavigate2(Sender: TObject;
const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
Headers: OleVariant; var Cancel: WordBool);
var
NewIndex: Integer;
begin
NewIndex := HistoryList.IndexOf(URL);
if NewIndex = -1 then
begin
{ Remove entries in HistoryList between last address and current address }
if (HistoryIndex >= 0) and (HistoryIndex < HistoryList.Count - 1) then
while HistoryList.Count > HistoryIndex do
HistoryList.Delete(HistoryIndex);
HistoryIndex := HistoryList.Add(URL);
end
else
HistoryIndex := NewIndex;
if UpdateCombo then
begin
UpdateCombo := False;
NewIndex := URLs.Items.IndexOf(URL);
if NewIndex = -1 then
URLs.Items.Insert(0, URL)
else
URLs.Items.Move(NewIndex, 0);
end;
URLs.Text := URL;
Statusbar1.Panels[0].Text := URL;
end;
procedure TMainForm.WebBrowser1DownloadBegin(Sender: TObject);
begin
{ Turn the stop button dark red }
StopBtn.ImageIndex := 4;
{ Play the avi from the first frame indefinitely }
end;
procedure TMainForm.WebBrowser1DownloadComplete(Sender: TObject);
begin
{ Turn the stop button grey }
StopBtn.ImageIndex := 2;
{ Stop the avi and show the first frame }
end;
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
URLs.Items.SaveToFile(ExtractFilePath(ParamStr(0)) + 'URL.dat');
end;
procedure TMainForm.FormActivate(Sender: TObject);
begin
if FileExists(ExtractFilePath(ParamStr(0)) + 'URL.dat') then
begin
URLs.Items.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'URL.dat');
end;
end;
procedure TMainForm.WebBrowser1ProgressChange(ASender: TObject; Progress,
ProgressMax: Integer);
begin
ProgressBar1.Max := ProgressMax; ProgressBar1.Position := Progress;
end;
procedure TMainForm.WebBrowser1NewWindow2(ASender: TObject;
var ppDisp: IDispatch; var Cancel: WordBool);
var
NewWindow: TMainForm;
begin
NewWindow := TMainForm.Create(self);
NewWindow.Show;
ppDisp := NewWindow.Webbrowser1.DefaultDispatch;
end;
procedure TMainForm.WebBrowser1Enter(Sender: TObject);
begin
Caption:=WebBrowser1.LocationName + ' - EiderNet 2 Beta 1';
end;
procedure TMainForm.WebBrowser1DocumentComplete(ASender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
Listbox1.Items.Add(Urls.text);
Listbox1.Items.SaveToFile('temporary\history.his');
end;
end.
Dodam, że Delphi kompiluje kod bez żadnych większych problemów.
Bardzo proszę o szybką odpowiedź!