Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 10.04.2011, 21:28   #1
HOOCH94
Пользователь
 
Регистрация: 08.11.2010
Сообщений: 21
По умолчанию рандомное падение программы

Всем привет, встретился с такой проблемой программа обсолютно рандомно крешится, порой при запуске, может чуть поработать и упась, если же запускать не через дебаггер то падает в 99.9% реже О_О, помогите разобраться в чем собсна дело, пробовал и построчное компилирование но каждый раз в разной части кода программа сыпалась, плюс глядя на код посоветуйте как можно оптимизировать или же наиболее логично сделать то или иное действие, всем спасибо.
Код:
unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,about, StdCtrls, Menus, AdvOfficePager, AdvGlowButton,mswheel,
  AdvLockApp, AdvMemo, AdvToolBar, OleCtrls, SHDocVw, CurvyControls, HTMLForm,
  AdvSmoothCalculator, AdvmWS, AeroButtons, ExtCtrls, CategoryButtons,MSHTML,
  ZipMstr19, ComCtrls;

type
  TForm1 = class(TForm)
    ZipMaster191: TZipMaster19;
    AdvOfficePager1: TAdvOfficePager;
    AdvOfficePager12: TAdvOfficePage;
    WebBrowser1: TWebBrowser;
    CategoryPanelGroup1: TCategoryPanelGroup;
    CategoryPanel1: TCategoryPanel;
    GroupBox1: TGroupBox;
    Edit1: TEdit;
    GroupBox2: TGroupBox;
    Button1: TButton;
    ProgressBar1: TProgressBar;
    ListBox1: TListBox;
    AdvOfficePager13: TAdvOfficePage;
    Button2: TButton;
    Label1: TLabel;
    procedure Exit1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure CategoryPanel1Collapse(Sender: TObject);
    procedure WebBrowser1ProgressChange(ASender: TObject; Progress,
      ProgressMax: Integer);
    procedure WebBrowser1DownloadComplete(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button3Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Label1Click(Sender: TObject);
  private
   Function MyRemoveDir(sDir : String) : Boolean;
  { Private declarations }
   // SourceText: WideString;
 //   TextRange: IHTMLTxtRange;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  url:string;
implementation

{$R *.dfm}


    procedure WBFindText(Browser: TWebBrowser; const Direction: Boolean; const FText: String;
  const SearchScope, Flags: Integer);
var
  Doc: IHTMLDocument2;
  SelObj: IHTMLSelectionObject;
  SelRange: IHtmlTxtRange;

begin
  Doc := Browser.Document as IHTMLDocument2;
  SelObj := Doc.Selection;
  SelRange := SelObj.CreateRange as IHTMLTxtRange;
  SelRange.Collapse(Direction);
  if SelRange.FindText(FText, SearchScope, Flags) then
  begin
    SelRange.Select;
    SelRange.ScrollIntoView(True);
  end
  else
 showMessage('По Вашему запросу ничего не найдено');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if listbox1.Visible=true then
begin
listbox1.Visible:=False;
button1.Caption:=('<');
end
else
begin
listbox1.Visible:=true;
button1.Caption:=('>');
end;
end;



procedure TForm1.Button2Click(Sender: TObject);
begin
webbrowser1.Navigate('youtube.ru');
end;

procedure TForm1.Button3Click(Sender: TObject);

var
url2,pdir:string;
begin
getdir(0,pdir);
url2:=pdir+'\home\'+'главная'+'.htm';
webbrowser1.Navigate(url2);
end;

procedure TForm1.CategoryPanel1Collapse(Sender: TObject);
begin
categorypanel1.Collapsed:=false;
end;
Вложения
Тип файла: zip исходник.zip (951.8 Кб, 7 просмотров)
HOOCH94 вне форума Ответить с цитированием
Старый 10.04.2011, 21:28   #2
HOOCH94
Пользователь
 
Регистрация: 08.11.2010
Сообщений: 21
По умолчанию

part 2 :
Код:
procedure TForm1.Edit1Change(Sender: TObject);
var
msg,capt:string;
begin
if edit1.Text=('') then
   begin
 //showmessage('Введите запрос поиска')
   msg:=('Поле поиска не заполнено');
   capt:=('Внимание!');
    MessageBox(0, PChar(Msg), PChar(Capt), MB_ICONASTERISK);
    end
    else
    WBFindText(webBrowser1, False, edit1.Text, 1, 0);
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin
form1.Close;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
pdir:string;
begin
getdir(0,pdir);
if NOT MyRemoveDir(pdir+'\res') then
ShowMessage('Не могу удалить эту директорию');
end;


procedure TForm1.FormCreate(Sender: TObject);
var
pdir:string;
begin
getdir(0,pdir);
zipmaster191.DLLDirectory:=(pdir+'\dll');
ZipMaster191.ZipFileName:='resouce.mfs';
with ZipMaster191 do {В данном случае все последующее процедуры, функции и переменные будут относиться к объекту ZipMaster1}
begin
if Count = 0 then
begin
ShowMessage('Файл данных повреждён!'); {Вывод сообщения об ошибке в случае отсутствия файлов в архиве}
Exit;
end;
ExtrBaseDir:=(pdir);{Определение директории для распаковки файлов. Очень важно иметь в виду, что Zip*Master не сможет извлечь файлы в несуществующую директорию, поэтому папка для извлечения файлов уже должна присутствовать на диске}
FSpecArgs.Add('*.*');{Определение файлов для извлечения. В данном случае будут извлечены все файлы в архиве}
ExtrOptions:=[ExtrOverwrite,ExtrDirNames];{В качестве опций извлечения файлов установлен параметр перезаписи существующих файлов}
Extract;
MessageBox(0,'Что бы начать работу выберите нужный раздел в левом меню', 'Внимание!', +mb_ok +mb_ICONWARNING);  {Вывод сообщения об успешном извлечении файлов из архива}
end;
begin
listbox1.Clear;
listbox1.Items.LoadFromFile(pdir+'\lb\i.lb');
end;
end;
procedure TForm1.Label1Click(Sender: TObject);
begin
webbrowser1.Navigate('');
end;

procedure TForm1.ListBox1Click(Sender: TObject);
var
pdir:string;
begin
getDir(0,pdir);
url:=pdir+'\res\w\'+listbox1.Items[listbox1.ItemIndex] +'.htm';
webbrowser1.Navigate(url);
webbrowser1.Navigate(url);
end;

function TForm1.MyRemoveDir(sDir: String): Boolean;

var
iIndex : Integer;
SearchRec : TSearchRec;
sFileName : String;
begin
Result := False;
sDir := sDir + '\*.*';
iIndex := FindFirst(sDir, faAnyFile, SearchRec);
while iIndex = 0 do begin
sFileName := ExtractFileDir(sDir)+'\'+SearchRec.Name;
if SearchRec.Attr = faDirectory then begin
if (SearchRec.Name <> '' ) and
(SearchRec.Name <> '.') and
(SearchRec.Name <> '..') then
MyRemoveDir(sFileName);
end
else
  begin
if SearchRec.Attr <> faArchive then
FileSetAttr(sFileName, faArchive);
if NOT DeleteFile(sFileName) then
ShowMessage('Could NOT delete ' + sFileName);
end;
iIndex := FindNext(SearchRec);
end;
FindClose(SearchRec);
RemoveDir(ExtractFileDir(sDir));
Result := True
end;

procedure TForm1.WebBrowser1DownloadComplete(Sender: TObject);

 begin
 WebBrowser1.OleObject.document.parentWindow.execScript('document.oncontextmenu='+
 'function(){event.returnValue=false}');
end;

procedure TForm1.WebBrowser1ProgressChange(ASender: TObject; Progress,
  ProgressMax: Integer);
begin
  Progressbar1.Max:=progressmax;
  Progressbar1.Position:=progress;
end;

end.

Последний раз редактировалось HOOCH94; 10.04.2011 в 21:31.
HOOCH94 вне форума Ответить с цитированием
Старый 10.04.2011, 21:48   #3
Человек_Борща
Старожил
 
Аватар для Человек_Борща
 
Регистрация: 30.12.2009
Сообщений: 11,442
По умолчанию

Использовать MadExcept для отлова "внезапных" исключений.
Человек_Борща вне форума Ответить с цитированием
Старый 10.04.2011, 21:59   #4
HOOCH94
Пользователь
 
Регистрация: 08.11.2010
Сообщений: 21
По умолчанию

А какие нибудь предложения по изменению кода будут? Просто интересно, как можно сделать лучше чем есть.
HOOCH94 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
рандомное заполнение массивов. Repac123456 Помощь студентам 8 24.11.2010 03:06
Рандомное заполнение массива ac1d_buRn Помощь студентам 15 03.05.2010 09:14
Взять рандомное предложение из текста zver777 Общие вопросы Delphi 4 09.04.2010 20:48
Ошибка и падение (выход) Excel при выполнении сложной программы на VBA Serge_Bliznykov Microsoft Office Excel 6 13.08.2008 16:50