Witam,
Od pewnego czasu piszemy ze znajomymi generator dokumentacji do Delphi ktory parsuje pliki pas i robi cos podobnego do doxygena czy javadoca. Wiemy ze takich projektow jest wiele i ze jest wiele zapewne lepszych, jednakze jesli ktos ma chwilke czasu zapaszamy do testow. Kod jest otwarty (download) dostepny przez SVN, ponizej link do pliku Exe (bez instalatora ofcourse ;) )
Ponizej link do DeDo v.0.0.1.137 Beta RC1.
http://www.assembla.com/spaces/DeDo/docume...name=1_DeDo.rar
Zerknąć nie zaszkodzi ... ;)
I popraw link ... ;)
http://www.assembla.com/spaces/DeDo/documents/cSYPuO1our3ibXabIlDkbG/download?filename=1_DeDo.rar
O sorka, jak jestem zalogowany na assembli to inaczej linki wygladaja. Albo nalezy znalezc space DeDo na assembli i w dziale files albo zaciagnac z tego linku:
na razie to sypie AV przy generuj :>
reichel napisał(a)
na razie to sypie AV przy generuj
Dokładnie ... to aby na pewno było sprawdzane ? ;>
Moj blad... zazwyczaj nie uzywam trybu "simple" wiec mi umknal jeden FreeAndNil ;)
poprawka jest tutaj:
http://www.assembla.com/spaces/DeDo/documents/an7JNy1pGr3j1YabIlDkbG/download?filename=1_DeDo.rar
i tutaj
http://thetosters.pl/DeDo/DeDo.rar
W przyszlosci postaram sie nie popelniac tak noobowskich baboli :/
test na 4 projektach
no i średnio mi się czcionka podoba w linkach
BTW dodaj np. ErrorDialoga z JEDI będzie wiadomo w której linii wystapił błąd
Podobnie jak u Misiekd i jeszcze (nie wszytsko - projekt sie kompiluje)
Using unit parser:
Default DeDo parser by Force, version: $Id: DeDo.Parser.pas 136 2008-02-05 2007Z Force_unit1 $
Using generator:
Default HTML generator by Toster [[email protected]] version $Id: HtmlEngine.pas 136 2008-02-05 2007Z Force_unit1 $
..................
Command nr. 31 is not be impelmanted in Space function in line 168:6
Command nr. 31 is not be impelmanted in Space function in line 169:14
Doble dot can't be used after function or operator in line 169:14
..............
You can't use semilcon here in line 17:4
Command nr. 51 is not be impelmanted in Space function in line 20:6
Command nr. 51 is not be impelmanted in Space function in line 21:10
..............
Command nr. 12 is not be impelmanted in Space function in line 168:6
Command nr. 12 is not be impelmanted in Space function in line 169:5
You can't use "=" here in line 169:6
You can't use "=" here in line 170:8
You can't use semilcon here in line 171:4
Done.
Generating documentation.
Exception while generating doc.: Access violation at address 00470848 in module 'DeDo.exe'. Read of address 6669748B
Done.
Jeśli można to jakbyście podali linijkę kodu w której on powiedział, że coś nie kuma. On numeruje od 0. To zobaczy się co on nie rozumie, może używacie rzadko używanych rzeczy:D
Using unit parser:
Default DeDo parser by Force, version: $Id: DeDo.Parser.pas 136 2008-02-05 20:10:07Z Force_unit1 $
Using generator:
Default HTML generator by Toster [[email protected]] version $Id: HtmlEngine.pas 136 2008-02-05 20:10:07Z Force_unit1 $
Found 5 files with source.
Parsing file: D:\Delphi\AutoRun\ErrorDialog.pas
You can't use double dot here in line 91:38
You can't use ")" here" in line 91:48
Command nr. 12 is not be impelmanted in Space function in line 93:10
Command nr. 12 is not be impelmanted in Space function in line 93:29
You can't use semilcon here in line 93:29
Command nr. 12 is not be impelmanted in Space function in line 94:10
Command nr. 12 is not be impelmanted in Space function in line 94:30
You can't use semilcon here in line 94:30
Command nr. 12 is not be impelmanted in Space function in line 95:10
Command nr. 12 is not be impelmanted in Space function in line 95:27
You can't use semilcon here in line 95:27
Command nr. 12 is not be impelmanted in Space function in line 96:10
Command nr. 12 is not be impelmanted in Space function in line 96:23
You can't use "(" here" in line 96:23
Command nr. 12 is not be impelmanted in Space function in line 96:29
Command nr. 12 is not be impelmanted in Space function in line 96:40
Command nr. 51 is not be impelmanted in Space function in line 114:11
Critical Method error in line 360
Critical Method error in line 367
Critical Method error in line 381
Critical Method error in line 409
You can't use double dot here in line 698:55
You can't use ")" here" in line 698:65
Command nr. 12 is not be impelmanted in Space function in line 706:27
Command nr. 12 is not be impelmanted in Space function in line 706:53
You can't use semilcon here in line 706:53
Command nr. 12 is not be impelmanted in Space function in line 722:10
Command nr. 12 is not be impelmanted in Space function in line 722:28
You can't use semilcon here in line 722:28
Command nr. 12 is not be impelmanted in Space function in line 739:10
Command nr. 12 is not be impelmanted in Space function in line 739:30
You can't use semilcon here in line 739:30
Command nr. 12 is not be impelmanted in Space function in line 749:10
Command nr. 12 is not be impelmanted in Space function in line 749:27
Command nr. 12 is not be impelmanted in Space function in line 749:40
You can't use "(" here" in line 749:40
Command nr. 12 is not be impelmanted in Space function in line 749:47
Critical Method error in line 749
Parsing file: D:\Delphi\AutoRun\fLogs.pas
Parsing file: D:\Delphi\AutoRun\fMain.pas
Critical Method error in line 91
Parsing file: D:\Delphi\AutoRun\fZadanie.pas
Parsing file: D:\Delphi\AutoRun\uConst.pas
Done.
Generating documentation.
Done.
a tu źródło D:\Delphi\AutoRun\ErrorDialog.pas
{**************************************************************************************************}
{ }
{ Project JEDI Code Library (JCL) }
{ }
{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
{ you may not use this file except in compliance with the License. You may obtain a copy of the }
{ License at http://www.mozilla.org/MPL/ }
{ }
{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
{ ANY KIND, either express or implied. See the License for the specific language governing rights }
{ and limitations under the License. }
{ }
{ The Original Code is ExceptDlg.pas. }
{ }
{ The Initial Developer of the Original Code is documented in the accompanying }
{ help file JCL.chm. Portions created by these individuals are Copyright (C) of these individuals. }
{ }
{**************************************************************************************************}
{ }
{ Sample Application exception dialog replacement }
{ }
{ Last modified: April 1, 2003 }
{ }
{**************************************************************************************************}
unit ErrorDialog;
{$I jcl.inc}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
StdCtrls, ExtCtrls, JclDebug;
const
UM_CREATEDETAILS = WM_USER + $100;
ReportToLogEnabled = $00000001; // TExceptionDialog.Tag property
DisableTextScrollbar = $00000002; // TExceptionDialog.Tag property
type
TSimpleExceptionLog = class(TObject)
private
FLogFileHandle: THandle;
FLogFileName: string;
FLogWasEmpty: boolean;
function GetLogOpen: boolean;
protected
function CreateDefaultFileName: string;
public
constructor Create(const ALogFileName: string = '');
destructor Destroy; override;
procedure CloseLog;
procedure OpenLog;
procedure Write(const Text: string; Indent: integer = 0); overload;
procedure Write(Strings: TStrings; Indent: integer = 0); overload;
procedure WriteStamp(SeparatorLen: integer = 0);
property LogFileName: string Read FLogFileName;
property LogOpen: boolean Read GetLogOpen;
end;
TExcDialogSystemInfo = (siStackList, siOsInfo, siModuleList, siActiveControls);
TExcDialogSystemInfos = set of TExcDialogSystemInfo;
TExceptionDialog = class(TForm)
OkBtn: TButton;
DetailsMemo: TMemo;
Bevel1: TBevel;
TextLabel: TMemo;
DetailsBtn: TButton;
SendBtn: TButton;
procedure FormPaint(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure DetailsBtnClick(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: word; Shift: TShiftState);
procedure FormDestroy(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure SendBtnClick(Sender: TObject);
private
FDetailsVisible: boolean;
FIsMainThead: boolean;
FLastActiveControl: TWinControl;
FNonDetailsHeight: integer;
FFullHeight: integer;
FSimpleLog: TSimpleExceptionLog;
procedure CreateDetails;
function GetReportAsText: string;
procedure ReportToLog;
procedure SetDetailsVisible(const Value: boolean);
procedure UMCreateDetails(var Message: TMessage); message UM_CREATEDETAILS;
protected
procedure AfterCreateDetails; dynamic;
procedure BeforeCreateDetails; dynamic;
procedure CreateDetailInfo; dynamic;
procedure CreateReport(const SystemInfo: TExcDialogSystemInfos);
function ReportMaxColumns: integer; virtual;
function ReportNewBlockDelimiterChar: char; virtual;
procedure NextDetailBlock;
procedure UpdateTextLabelScrollbars;
public
procedure CopyReportToClipboard;
class procedure ExceptionHandler(Sender: TObject; E: Exception);
class procedure ExceptionThreadHandler(Thread: TJclDebugThread);
class procedure ShowException(E: Exception; Thread: TJclDebugThread);
property DetailsVisible: boolean Read FDetailsVisible Write SetDetailsVisible;
property ReportAsText: string Read GetReportAsText;
property SimpleLog: TSimpleExceptionLog Read FSimpleLog;
end;
TExceptionDialogClass = class of TExceptionDialog;
resourcestring
RsAppError = '%s - błąd aplikacji';
RsExceptionClass = 'Exception class: %s';
RsExceptionAddr = 'Exception address: %p';
RsStackList = 'Stack list, generated %s';
RsModulesList = 'List of loaded modules:';
RsOSVersion = 'System : %s %s, Version: %d.%d, Build: %x, "%s"';
RsProcessor = 'Processor: %s, %s, %d MHz %s%s';
RsScreenRes = 'Display : %dx%d pixels, %d bpp';
RsActiveControl = 'Active Controls hierarchy:';
RsThread = 'Thread: %s';
RsMissingVersionInfo = '(no version info)';
const
SendBugReportPort = 25;
var
ExceptionDialogClass: TExceptionDialogClass = TExceptionDialog;
implementation
{$R *.DFM}
uses
ClipBrd, Math, JclBase, JclFileUtils, JclHookExcept,
JclPeImage, JclStrings, JclSysInfo, JclSysUtils,
uImport;
var
ExceptionDialog: TExceptionDialog;
//==================================================================================================
// Helper routines
//==================================================================================================
function GetBPP: integer;
var
DC: HDC;
begin
DC := GetDC(0);
Result := GetDeviceCaps(DC, BITSPIXEL) * GetDeviceCaps(DC, PLANES);
ReleaseDC(0, DC);
end;
//--------------------------------------------------------------------------------------------------
function SortModulesListByAddressCompare(List: TStringList;
Index1, Index2: integer): integer;
begin
Result := integer(List.Objects[Index1]) - integer(List.Objects[Index2]);
end;
//==================================================================================================
// TApplication.HandleException method code hooking for exceptions from DLLs
//==================================================================================================
// We need to catch the last line of TApplication.HandleException method:
// [...]
// end else
// SysUtils.ShowException(ExceptObject, ExceptAddr);
// end;
procedure HookShowException(ExceptObject: TObject; ExceptAddr: Pointer);
begin
if JclValidateModuleAddress(ExceptAddr) and (ExceptObject.InstanceSize >=
Exception.InstanceSize) then
TExceptionDialog.ExceptionHandler(nil, Exception(ExceptObject))
else
SysUtils.ShowException(ExceptObject, ExceptAddr);
end;
//--------------------------------------------------------------------------------------------------
function HookTApplicationHandleException: boolean;
const
CallOffset = $86;
CallOffsetDebug = $94;
type
PCALLInstruction = ^TCALLInstruction;
TCALLInstruction = packed record
Call: byte;
Address: integer;
end;
var
TApplicationHandleExceptionAddr, SysUtilsShowExceptionAddr: Pointer;
CALLInstruction: TCALLInstruction;
CallAddress: Pointer;
NW: DWORD;
function CheckAddressForOffset(Offset: cardinal): boolean;
begin
try
CallAddress := Pointer(cardinal(TApplicationHandleExceptionAddr) + Offset);
CALLInstruction.Call := $E8;
Result := PCALLInstruction(CallAddress)^.Call = CALLInstruction.Call;
if Result then
if IsCompiledWithPackages then
Result := PeMapImgResolvePackageThunk(Pointer(integer(CallAddress) +
integer(PCALLInstruction(CallAddress)^.Address) + SizeOf(CALLInstruction))) =
SysUtilsShowExceptionAddr
else
Result := PCALLInstruction(CallAddress)^.Address =
integer(SysUtilsShowExceptionAddr) - integer(CallAddress) - SizeOf(CALLInstruction);
except
Result := False;
end;
end;
begin
TApplicationHandleExceptionAddr :=
PeMapImgResolvePackageThunk(@TApplication.HandleException);
SysUtilsShowExceptionAddr := PeMapImgResolvePackageThunk(@SysUtils.ShowException);
Result := CheckAddressForOffset(CallOffset) or CheckAddressForOffset(CallOffsetDebug);
if Result then
begin
CALLInstruction.Address :=
integer(@HookShowException) - integer(CallAddress) - SizeOf(CALLInstruction);
Result := WriteProcessMemory(GetCurrentProcess, CallAddress,
@CALLInstruction, SizeOf(CALLInstruction), NW);
if Result then
FlushInstructionCache(GetCurrentProcess, CallAddress, SizeOf(CALLInstruction));
end;
end;
//==================================================================================================
// TSimpleExceptionLog
//==================================================================================================
procedure TSimpleExceptionLog.CloseLog;
begin
if LogOpen then
begin
CloseHandle(FLogFileHandle);
FLogFileHandle := INVALID_HANDLE_VALUE;
FLogWasEmpty := False;
end;
end;
//--------------------------------------------------------------------------------------------------
constructor TSimpleExceptionLog.Create(const ALogFileName: string);
begin
if ALogFileName = '' then
FLogFileName := CreateDefaultFileName
else
FLogFileName := ALogFileName;
FLogFileHandle := INVALID_HANDLE_VALUE;
end;
//--------------------------------------------------------------------------------------------------
function TSimpleExceptionLog.CreateDefaultFileName: string;
begin
Result := PathExtractFileDirFixed(ParamStr(0)) +
PathExtractFileNameNoExt(ParamStr(0)) + '_Err.log';
end;
//--------------------------------------------------------------------------------------------------
destructor TSimpleExceptionLog.Destroy;
begin
CloseLog;
inherited;
end;
//--------------------------------------------------------------------------------------------------
function TSimpleExceptionLog.GetLogOpen: boolean;
begin
Result := FLogFileHandle <> INVALID_HANDLE_VALUE;
end;
//--------------------------------------------------------------------------------------------------
procedure TSimpleExceptionLog.OpenLog;
begin
if not LogOpen then
begin
FLogFileHandle := CreateFile(PChar(FLogFileName), GENERIC_WRITE,
FILE_SHARE_READ, nil,
OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
if LogOpen then
FLogWasEmpty := SetFilePointer(FLogFileHandle, 0, nil, FILE_END) = 0;
end
else
FLogWasEmpty := False;
end;
//--------------------------------------------------------------------------------------------------
procedure TSimpleExceptionLog.Write(const Text: string; Indent: integer);
var
S: string;
SL: TStringList;
I: integer;
begin
if LogOpen then
begin
SL := TStringList.Create;
try
SL.Text := Text;
for I := 0 to SL.Count - 1 do
begin
S := StringOfChar(' ', Indent) + StrEnsureSuffix(AnsiCrLf, TrimRight(SL[I]));
FileWrite(integer(FLogFileHandle), Pointer(S)^, Length(S));
end;
finally
SL.Free;
end;
end;
end;
//--------------------------------------------------------------------------------------------------
procedure TSimpleExceptionLog.Write(Strings: TStrings; Indent: integer);
var
I: integer;
begin
for I := 0 to Strings.Count - 1 do
Write(Strings[I], Indent);
end;
//--------------------------------------------------------------------------------------------------
procedure TSimpleExceptionLog.WriteStamp(SeparatorLen: integer);
begin
if SeparatorLen = 0 then
SeparatorLen := 100;
SeparatorLen := Max(SeparatorLen, 20);
OpenLog;
if not FLogWasEmpty then
Write(AnsiCrLf);
Write(StrRepeat('=', SeparatorLen));
Write(Format('= %-*s =', [SeparatorLen - 4, DateTimeToStr(Now)]));
Write(StrRepeat('=', SeparatorLen));
end;
//==================================================================================================
// Exception dialog
//==================================================================================================
var
ExceptionShowing: boolean;
{ TExceptionDialog }
procedure TExceptionDialog.AfterCreateDetails;
begin
SendBtn.Enabled := True;
end;
//--------------------------------------------------------------------------------------------------
procedure TExceptionDialog.BeforeCreateDetails;
begin
SendBtn.Enabled := False;
end;
//--------------------------------------------------------------------------------------------------
procedure TExceptionDialog.CopyReportToClipboard;
begin
ClipBoard.AsText := ReportAsText;
end;
//--------------------------------------------------------------------------------------------------
procedure TExceptionDialog.CreateDetailInfo;
begin
CreateReport([siStackList, siOsInfo, siModuleList, siActiveControls]);
end;
//--------------------------------------------------------------------------------------------------
procedure TExceptionDialog.CreateDetails;
begin
Screen.Cursor := crHourGlass;
DetailsMemo.Lines.BeginUpdate;
try
CreateDetailInfo;
ReportToLog;
DetailsMemo.SelStart := 0;
SendMessage(DetailsMemo.Handle, EM_SCROLLCARET, 0, 0);
AfterCreateDetails;
finally
DetailsMemo.Lines.EndUpdate;
OkBtn.Enabled := True;
DetailsBtn.Enabled := True;
OkBtn.SetFocus;
Screen.Cursor := crDefault;
end;
end;
//--------------------------------------------------------------------------------------------------
procedure TExceptionDialog.CreateReport(const SystemInfo: TExcDialogSystemInfos);
const
MMXText: array[boolean] of PChar = ('', 'MMX');
FDIVText: array[boolean] of PChar = (' [FDIV Bug]', '');
var
SL: TStringList;
I: integer;
ModuleName: TFileName;
CpuInfo: TCpuInfo;
C: TWinControl;
NtHeaders: PImageNtHeaders;
ModuleBase: cardinal;
ImageBaseStr: string;
StackList: TJclStackInfoList;
begin
SL := TStringList.Create;
try
// Stack list
if siStackList in SystemInfo then
begin
StackList := JclLastExceptStackList;
if Assigned(StackList) then
begin
DetailsMemo.Lines.Add(Format(RsStackList, [DateTimeToStr(StackList.TimeStamp)]));
StackList.AddToStrings(DetailsMemo.Lines, False, True, True);
NextDetailBlock;
end;
end;
// System and OS information
if siOsInfo in SystemInfo then
begin
DetailsMemo.Lines.Add(Format(RsOSVersion,
[GetWindowsVersionString, NtProductTypeString,
Win32MajorVersion, Win32MinorVersion, Win32BuildNumber, Win32CSDVersion]));
GetCpuInfo(CpuInfo);
with CpuInfo do
DetailsMemo.Lines.Add(Format(RsProcessor, [Manufacturer, CpuName,
RoundFrequency(FrequencyInfo.NormFreq),
MMXText[MMX], FDIVText[IsFDIVOK]]));
DetailsMemo.Lines.Add(Format(RsScreenRes, [Screen.Width, Screen.Height, GetBPP]));
NextDetailBlock;
end;
// Modules list
if (siModuleList in SystemInfo) and LoadedModulesList(SL, GetCurrentProcessId) then
begin
DetailsMemo.Lines.Add(RsModulesList);
SL.CustomSort(SortModulesListByAddressCompare);
for I := 0 to SL.Count - 1 do
begin
ModuleName := SL[I];
ModuleBase := cardinal(SL.Objects[I]);
DetailsMemo.Lines.Add(Format('[%.8x] %s', [ModuleBase, ModuleName]));
NtHeaders := PeMapImgNtHeaders(Pointer(ModuleBase));
if (NtHeaders <> nil) and (NtHeaders^.OptionalHeader.ImageBase <>
ModuleBase) then
ImageBaseStr := Format('<%.8x> ', [NtHeaders^.OptionalHeader.ImageBase])
else
ImageBaseStr := StrRepeat(' ', 11);
if VersionResourceAvailable(ModuleName) then
with TJclFileVersionInfo.Create(ModuleName) do
try
DetailsMemo.Lines.Add(ImageBaseStr + BinFileVersion + ' - ' + FileVersion);
if FileDescription <> '' then
DetailsMemo.Lines.Add(StrRepeat(' ', 11) + FileDescription);
finally
Free;
end
else
DetailsMemo.Lines.Add(ImageBaseStr + RsMissingVersionInfo);
end;
NextDetailBlock;
end;
// Active controls
if (siActiveControls in SystemInfo) and (FLastActiveControl <> nil) then
begin
DetailsMemo.Lines.Add(RsActiveControl);
C := FLastActiveControl;
while C <> nil do
begin
DetailsMemo.Lines.Add(Format('%s "%s"', [C.ClassName, C.Name]));
C := C.Parent;
end;
NextDetailBlock;
end;
finally
SL.Free;
end;
end;
//--------------------------------------------------------------------------------------------------
procedure TExceptionDialog.DetailsBtnClick(Sender: TObject);
begin
DetailsVisible := not DetailsVisible;
end;
//--------------------------------------------------------------------------------------------------
class procedure TExceptionDialog.ExceptionHandler(Sender: TObject; E: Exception);
begin
if ExceptionShowing then
Application.ShowException(E)
else begin
ExceptionShowing := True;
try
ShowException(E, nil);
finally
ExceptionShowing := False;
end;
end;
end;
//--------------------------------------------------------------------------------------------------
class procedure TExceptionDialog.ExceptionThreadHandler(Thread: TJclDebugThread);
begin
if ExceptionShowing then
Application.ShowException(Thread.SyncException)
else begin
ExceptionShowing := True;
try
ShowException(Thread.SyncException, Thread);
finally
ExceptionShowing := False;
end;
end;
end;
//--------------------------------------------------------------------------------------------------
procedure TExceptionDialog.FormCreate(Sender: TObject);
begin
FSimpleLog := TSimpleExceptionLog.Create;
FFullHeight := ClientHeight;
DetailsVisible := False;
Caption := Format(RsAppError, [Application.Title]);
end;
//--------------------------------------------------------------------------------------------------
procedure TExceptionDialog.FormDestroy(Sender: TObject);
begin
FreeAndNil(FSimpleLog);
end;
//--------------------------------------------------------------------------------------------------
procedure TExceptionDialog.FormKeyDown(Sender: TObject; var Key: word;
Shift: TShiftState);
begin
if (Key = Ord('C')) and (ssCtrl in Shift) then
begin
CopyReportToClipboard;
MessageBeep(MB_OK);
end;
end;
//--------------------------------------------------------------------------------------------------
procedure TExceptionDialog.FormPaint(Sender: TObject);
begin
DrawIcon(Canvas.Handle, TextLabel.Left - GetSystemMetrics(SM_CXICON) - 15,
TextLabel.Top, LoadIcon(0, IDI_ERROR));
end;
//--------------------------------------------------------------------------------------------------
procedure TExceptionDialog.FormResize(Sender: TObject);
begin
UpdateTextLabelScrollbars;
end;
//--------------------------------------------------------------------------------------------------
procedure TExceptionDialog.FormShow(Sender: TObject);
begin
BeforeCreateDetails;
MessageBeep(MB_ICONERROR);
if FIsMainThead and (GetWindowThreadProcessId(Handle, nil) = MainThreadID) then
PostMessage(Handle, UM_CREATEDETAILS, 0, 0)
else
CreateDetails;
end;
//--------------------------------------------------------------------------------------------------
function TExceptionDialog.GetReportAsText: string;
begin
Result := StrEnsureSuffix(AnsiCrLf, TextLabel.Text) + AnsiCrLf + DetailsMemo.Text;
end;
//--------------------------------------------------------------------------------------------------
procedure TExceptionDialog.NextDetailBlock;
begin
DetailsMemo.Lines.Add(StrRepeat(ReportNewBlockDelimiterChar, ReportMaxColumns));
end;
//--------------------------------------------------------------------------------------------------
function TExceptionDialog.ReportMaxColumns: integer;
begin
// Result := 100;
Result := 78;
end;
//--------------------------------------------------------------------------------------------------
function TExceptionDialog.ReportNewBlockDelimiterChar: char;
begin
Result := '-';
end;
//--------------------------------------------------------------------------------------------------
procedure TExceptionDialog.ReportToLog;
begin
if Tag and ReportToLogEnabled <> 0 then
begin
FSimpleLog.WriteStamp(ReportMaxColumns);
try
FSimpleLog.Write(ReportAsText);
finally
FSimpleLog.CloseLog;
end;
end;
end;
//--------------------------------------------------------------------------------------------------
procedure TExceptionDialog.SetDetailsVisible(const Value: boolean);
var
DetailsCaption: string;
begin
FDetailsVisible := Value;
DetailsCaption := Trim(StrRemoveChars(DetailsBtn.Caption, ['<', '>']));
if Value then
begin
Constraints.MinHeight := FNonDetailsHeight + 100;
Constraints.MaxHeight := Screen.Height;
DetailsCaption := '<< ' + DetailsCaption;
ClientHeight := FFullHeight;
DetailsMemo.Height := FFullHeight - DetailsMemo.Top - 3;
end
else begin
FFullHeight := ClientHeight;
DetailsCaption := DetailsCaption + ' >>';
if FNonDetailsHeight = 0 then
begin
ClientHeight := Bevel1.Top;
FNonDetailsHeight := Height;
end
else
Height := FNonDetailsHeight;
Constraints.MinHeight := FNonDetailsHeight;
Constraints.MaxHeight := FNonDetailsHeight
end;
DetailsBtn.Caption := DetailsCaption;
DetailsMemo.Enabled := Value;
end;
//--------------------------------------------------------------------------------------------------
class procedure TExceptionDialog.ShowException(E: Exception; Thread: TJclDebugThread);
begin
if ExceptionDialog = nil then
ExceptionDialog := ExceptionDialogClass.Create(Application);
try
with ExceptionDialog do
begin
FIsMainThead := (GetCurrentThreadId = MainThreadID);
FLastActiveControl := Screen.ActiveControl;
TextLabel.Text := AdjustLineBreaks(StrEnsureSuffix('.', E.Message));
UpdateTextLabelScrollbars;
DetailsMemo.Lines.Add(Format(RsExceptionClass, [E.ClassName]));
if Thread = nil then
DetailsMemo.Lines.Add(Format(RsExceptionAddr, [ExceptAddr]))
else
DetailsMemo.Lines.Add(Format(RsThread, [Thread.ThreadInfo]));
NextDetailBlock;
ShowModal;
end;
finally
FreeAndNil(ExceptionDialog);
end;
end;
//--------------------------------------------------------------------------------------------------
procedure TExceptionDialog.UMCreateDetails(var Message: TMessage);
begin
Update;
CreateDetails;
end;
//--------------------------------------------------------------------------------------------------
procedure TExceptionDialog.UpdateTextLabelScrollbars;
begin
if Tag and DisableTextScrollbar = 0 then
begin
Canvas.Font := TextLabel.Font;
if TextLabel.Lines.Count * Canvas.TextHeight('Wg') > TextLabel.ClientHeight then
TextLabel.ScrollBars := ssVertical
else
TextLabel.ScrollBars := ssNone;
end;
end;
//==================================================================================================
// Exception handler initialization code
//==================================================================================================
procedure InitializeHandler;
begin
JclStackTrackingOptions := JclStackTrackingOptions + [stRawMode];
{$IFNDEF HOOK_DLL_EXCEPTIONS}
JclStackTrackingOptions := JclStackTrackingOptions + [stStaticModuleList];
{$ENDIF HOOK_DLL_EXCEPTIONS}
JclDebugThreadList.OnSyncException := TExceptionDialog.ExceptionThreadHandler;
JclStartExceptionTracking;
{$IFDEF HOOK_DLL_EXCEPTIONS}
if HookTApplicationHandleException then
JclTrackExceptionsFromLibraries;
{$ENDIF HOOK_DLL_EXCEPTIONS}
Application.OnException := TExceptionDialog.ExceptionHandler;
end;
//--------------------------------------------------------------------------------------------------
procedure UnInitializeHandler;
begin
Application.OnException := nil;
JclDebugThreadList.OnSyncException := nil;
JclUnhookExceptions;
JclStopExceptionTracking;
end;
//--------------------------------------------------------------------------------------------------
procedure TExceptionDialog.SendBtnClick(Sender: TObject);
begin
SendBugReport('Gazetka 0.1', PChar(ReportAsText), Application.Handle);
ModalResult := mrOk;
end;
initialization
InitializeHandler;
finalization
UnInitializeHandler;
end.
jak na mój gust to on wskazuje całkiem co innego niż jest w kodzie :/
Ok, wiem w czym jest błąd:
//92:
procedure TfrmMain.AddLog(TypLogu: TTypLogu; Czas: TDateTime; Plik, Parametry, Text: string);
//interface:
procedure AddLog(TypLogu: TTypLogu; Czas: TDateTime; Plik, Parametry: string; Text: string);
Poprawiony został bug z tym message oraz jest obsługa sekcji resourcestring, aczkolwiek a generowanej dokumentacji pokaże się wieczorem. Ten bug z metodą też został usunięty (tak mi się wydaje).
Nowy link:
http://www.assembla.com/spaces/DeDo/documents/bWgFXo1xir3j1YabIlDkbG/download?filename=1_2_DeDo.rar
Większa ilość testów mile widziana:)
kod
http://rudy.mif.pg.gda.pl/~reichel/down.php?id=50
i AV (co prawda cos tam wypluwa)
w pozostalych
http://rudy.mif.pg.gda.pl/~reichel/showcat.php?id=4
czesto krzyczy
Ok poprawiłem część kodu. Link jest tutaj:
http://www.assembla.com/spaces/DeDo/documents/cm9hpk1CGr3iaLabIlDkbG/download?filename=1_3_DeDo.rar
Okazało się, że pomyliłem sobie, że packed jest przed record a nie po:D
Ale też zrobiłem małą listę co nie kuma i się gubi i to nie będzie poprawione szybko:
Ale w mojej opinii, są to małe wady i rzadko spotykane kody.
no nie powiedzial bym, moze:
ale reszta jak najbardziej spotykana (szczegolnie ostatnia linijka - dynamicznie ladowane dll'e)
LOL. Zaraz po ustawieniu folderów i nacisnięciu Generate
Facet, publikuj coś dopiero jak działa.
[diabel] :-[ :-[
Entek: nie wiem z którego linka ściągałeś program. W moim prawie ostatnim poście bodajże masz link http://www.assembla.com/spaces/DeDo/documents/bWgFXo1xir3j1YabIlDkbG/download?filename=1_2_DeDo.rar w nim u mnie zadziałało to co mówisz, że Tobie nie, to opisz dokładnie iel razy naciskałeś generate i czy może akurat Twój kod zawiera to co ja napisałem, że DeDo nie parsuje. DeDo nie jest tylko moim programem i nie został udostępniony jako wersja gotowa, ale właśnie po to aby przetestowali inni na swoich kodach, bo na naszych zawsze działa, ale skoro my piszemy parser to nie znajdziemy sami bugów. Jak widać tutaj część osób przetestowała i dzięki temu kilka poważnych bugów zostało usuniętych, z resztą Toster w pierwszej linijce powiedział "Beta RC1".
reichel: może są często spotykane, dla projektów które my piszemy obejmuje wszystko, dla Twoich kodów też jak testowałem z Twojej strony. Dodanie threadvarów może nie będzie wielką robotą, linijki Coś = class(coś); są spotykane, ale z mojej opinii rzadko i jak wspomniałem, DeDo je parsuje ale jeśli są w interface, to zawsze można przenieść do interface. Ze słowem kluczowym na końcu typu funkcyjnego raz się spotkałem, właśnie w Twoim kodzie, nigdzie indziej nie widywałem:D Może tylko żal tych DLL, ale jak wspomniałem program powstał do większego projektu jako narzędzie pomocnicze i w tej roli spełnia swoje zadanie :)
Sprawdzałem wersje 1.3
http://www.assembla.com/spaces/DeDo/documents/cm9hpk1CGr3iaLabIlDkbG/download?filename=1_3_DeDo.rar
Próbowałem kilka razy, różne katalogi i zawsze exception po nacisnieciu Generate.
Co więcej mogę dodać?
Gdybyście podali kod źródłowy, lub odnośnik do CVS albo SVN, mógłbym coś więcej powiedzieć, a tak jedynie tyle, że program nie działa.
No, a jeśli ktoś ściąga program i potem próbuje uruchomić, to ma prawo być poirytowany, gdy widzi że jest on wadliwy i wywala sie zaraz po naciśnięciu start.
Jeśli już chcecie by testowano wasz program, bez udostępniania źródeł, to chociaż mogliście dodać do niego jakiś dodatek typu Eurekalog - http://www.eurekalog.com/
Toster mówił: "Kod jest otwarty (download) dostepny przez SVN". Może trochę mniej agresji, nie sprzedajemy Ci Office-a tylko aby testowano program, i większej umiejętności czytania ze zrozumiem. Zrobiłeś kiedyś coś dużego bez bugów? I nie rozumiem czemu ktoś miałby być poirytowany, że wersja beta się wywala, przecież dlatego nazywa się beta. Skoro nie zauważyłeś że kod jest dostępny to mogłeś sam dać kod, na którym testowałeś.
Nazwa przestrzeni na assembli wyciągnięta z wszystkich linków:
http://www.assembla.com/spaces/DeDo
Sorki za mala moja aktywnosc ale pisze po nocach i tak jak Force wczesniej mowil DeDo jest de facto projektem pomocniczym do innego duzo wiekszego projektu.
entek: Zgodnie z tym co napisalem wczesniej (a pozniej Force to zacytowal) wszysko jest dostepne do sciagniecia. Wiec jesli masz chec i ochote zaciagnij skompiluj i pobaw sie zrodlami. Jesli podeslesz kawalek kodu na ktorym DeDo sie wywala to postaramy sie naprawic problem. Jesli chcesz mozesz samemu zaproponowac poprawke/zmiane.
Anyway, thx dla wszystkich ktorzy nam pomogli, maja zamiar pomoc lub robia to aktualnie.
No faktycznie, troche mnie poniosło.
Nie robi błędów ten, co nic nie robi.
Program zatrzymuje sie w tym miejscu:
begin // Musi to być klasa skoro już jest
DDClassType := DDSection.DDTypes[temp] as TDDClass;
First chance exception at $7C812A5B. Exception class EInvalidCast with message 'Invalid class typecast'. Process DeDo.exe (3288)
Kolejny errer:
procedure TForceStack.Clear(Proc : TForceProc1);
var
temp, temp2 : PForceSQRecord;
begin
temp := FTop;
while temp <> nil do
begin
Dec(FHeight);
Proc(temp^.Value);
temp2 := temp^.Next; <------------
Dispose(temp);
temp := temp2;
end;
end;
First chance exception at $7C812A5B. Exception class EAccessViolation with message 'Access violation at address 0040433A in module 'DeDo.exe'. Read of address 0000049C'. Process DeDo.exe (2780)
Na 100% problemem jest cdecl.
TMDAPIGetPluginName = procedure(Buf: PByteArray); cdecl;
TMDAPIProcessPluginMenuCommandProc = procedure( MenuID:integer );cdecl;
TMDAPIProcessChannelChange=procedure(prg: TProgramm82); cdecl;
Najpierw przy linijce:
temp := DDSection.GetTypeIndex(s2);
temp jest równy -1 i tworzy sie klasa DDType := TDDType.Create;
Potem temp równa sie 26 i przy
DDClassType := DDSection.DDTypes[temp] as TDDClass;
następuje exception.
Dzięki, ale ten błąd jest nam znany i jest na liście rzeczy: "Tego DeDo nie kuma i w tej wersji nie będzie kumać", napisałem ją w poprzednim poście jako "Tego DeDo nie kuma", czyli: gdy tworzymy stałe/zmienne typu funkcyjnego to nie mogą być za nimi modyfikatory dla metod, DeDo tego nie wyczaja, takie modyfikatory tylko dla metod-metod mogą być.
Ale dzięki za czujność i dociekliwość :)
A kod rzeczywiście jest skomplikowany bo był pisane on-line (przynajmniej przeze mnie, Toster zazwyczaj myśli :P)
Edit:
Przemyślałem sprawę i można teraz dodawać te słowa kluczowe na koniec tych zmiennych i typów, ale jest to przez nadużycie bo tak naprawdę są ona ustawiane dla zmiennych/typów, a nie tych metod.
Link do zmian: http://www.assembla.com/spaces/DeDo/documents/d9UXyO1O8r3kdlabIlDkbG/download?filename=1_4_DeDo.rar
Są także inne drobniejsze poprawki.
Edit2: ja gdy szukam, która linijka to daje tam breakpointa i patrze ile wynosi ostatnia wartości "i" zanim rzuci taki błąd.
Teraz lepiej, wersja 1.4 nie wywala sie juz u mnie na 'cdecl'.
No widzisz, cuda :D Ale dodałem parę poprawek. Oto link: http://www.assembla.com/spaces/DeDo/documents/cwPbMU1Vir3i_IabIlDkbG/download?filename=1_5_DeDo.rar
Zmieniło się: