pascal/kolmck
1
0
Fork 0
Code Issues Releases Activity

v3.i

Browse Source 
git-svn-id: https://svn.code.sf.net/p/kolmck/code@78 91bb2d04-0c0c-4d2d-88a5-bbb6f4c1fa07
This commit is contained in:
dkolmck
2010-10-12 17:54:18 +00:00
parent bbd0e2aee6
commit 19cb111bcd
6 changed files with 1314 additions and 433 deletions
Download Patch File Download Diff File Expand all files Collapse all files

77
Addons/err.pas
View File

@ -21,11 +21,10 @@
Key Objects Library (C) 2000 by Kladov Vladimir.
mailto: bonanzas@xcl.cjb.net
Home: http://kol.nm.ru
http://xcl.cjb.net
http://xcl.nm.ru
mailto: vk@kolmck.net
Home: http://kolmck.net
This version is compatible with KOL 3.00+
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-}
{
This code is grabbed mainly from standard SysUtils.pas unit,
@ -125,7 +124,7 @@ resourcestring
SReadAccess = 'Read';
SWriteAccess = 'Write';
//SResultTooLong = 'Format result longer than 4096 characters';
//SFormatTooLong = 'Format AnsiString too long';
//SFormatTooLong = 'Format string too long';
SExternalException = 'External exception %x';
SAssertionFailed = 'Assertion failed';
SIntfCastError = 'Interface not supported';
@ -152,7 +151,7 @@ type
{ Generic filename type }
TFileName = type AnsiString;
TFileName = type string;
{ Exceptions }
Exception = class;
@ -177,31 +176,31 @@ type
protected
FCode: TError;
FErrorCode: DWORD;
FMessage: AnsiString;
FMessage: KOLString;
FExceptionRecord: PExceptionRecord;
FData: Pointer;
FOnDestroy: TDestroyException;
procedure SetData(const Value: Pointer);
public
constructor Create(ACode: TError; const Msg: AnsiString);
constructor Create(ACode: TError; const Msg: string);
{* Use this constructor to raise exception, which does not require of
argument formatting. }
constructor CreateFmt(ACode: TError; const Msg: AnsiString; const Args: array of const);
{* Use this constructor to raise an exception with formatted Message AnsiString.
constructor CreateFmt(ACode: TError; const Msg: string; const Args: array of const);
{* Use this constructor to raise an exception with formatted Message string.
Take into attention, that Format procedure defined in KOL, uses API wvsprintf
function, which can understand a restricted set of format specifications. }
constructor CreateCustom(AError: DWORD; const Msg: AnsiString);
constructor CreateCustom(AError: DWORD; const Msg: String);
{* Use this constructor to create e_Custom exception and to assign AError to
its ErrorCode property. }
constructor CreateCustomFmt(AError: DWORD; const Msg: AnsiString; const Args: array of const);
constructor CreateCustomFmt(AError: DWORD; const Msg: String; const Args: array of const);
{* Use this constructor to create e_Custom exception with formatted message
AnsiString and to assign AError to its ErrorCode property. }
string and to assign AError to its ErrorCode property. }
constructor CreateResFmt(ACode: TError; Ident: Integer; const Args: array of const);
{* }
destructor Destroy; override;
{* destructor }
property Message: AnsiString read FMessage; // write FMessage;
{* Text AnsiString, containing descriptive message about the exception. }
property Message: KOLString read FMessage; // write FMessage;
{* Text string, containing descriptive message about the exception. }
property Code: TError read FCode;
{* Main exception code. This property can be used to determine, which exception
occure. }
@ -253,7 +252,7 @@ procedure AddExitProc(Proc: TProcedure);
{ System error messages }
function SysErrorMessage(ErrorCode: Integer): AnsiString;
function SysErrorMessage(ErrorCode: Integer): string;
{ Exception handling routines }
@ -327,7 +326,7 @@ function SafeLoadLibrary(const Filename: KOLString;
implementation
{procedure ConvertError(const Ident: AnsiString);
{procedure ConvertError(const Ident: string);
begin
raise Exception.Create(e_Convert, Ident);
end;
@ -385,7 +384,7 @@ end;
{ System error messages }
function SysErrorMessage(ErrorCode: Integer): AnsiString;
function SysErrorMessage(ErrorCode: Integer): string;
var
Len: Integer;
Buffer: array[0..255] of KOLChar;
@ -492,7 +491,7 @@ end;
{$ENDIF}
{$IFDEF _D2}
function LoadStr(Ident: Integer): AnsiString;
function LoadStr(Ident: Integer): string;
var
Buffer: array[0..1023] of Char;
begin
@ -500,7 +499,7 @@ begin
SizeOf(Buffer)));
end;
{$ELSE}
function LoadStr(Ident: Integer): AnsiString;
function LoadStr(Ident: Integer): string;
var
Buffer: array[0..1023] of KOLChar;
begin
@ -508,7 +507,7 @@ begin
end;
{$ENDIF}
function FmtLoadStr(Ident: Integer; const Args: array of const): AnsiString;
function FmtLoadStr(Ident: Integer; const Args: array of const): string;
begin
//FmtStr(Result, LoadStr(Ident), Args);
Result := Format(LoadStr(Ident), Args);
@ -517,12 +516,12 @@ end;
function ExceptionErrorMessage(ExceptObject: TObject; ExceptAddr: Pointer;
Buffer: PKOLChar; Size: Integer): Integer;
var
MsgPtr: PAnsiChar;
//MsgEnd: PAnsiChar;
MsgPtr: PKOLChar;
//MsgEnd: PChar;
//MsgLen: Integer;
ModuleName: array[0..MAX_PATH] of KOLChar;
//Temp: array[0..MAX_PATH] of Char;
Fmt: array[0..255] of AnsiChar;
Fmt: array[0..255] of KOLChar;
Info: TMemoryBasicInformation;
ConvertedAddress: Pointer;
begin
@ -543,21 +542,21 @@ begin
//MsgEnd := '';
if ExceptObject is Exception then
begin
MsgPtr := PAnsiChar(Exception(ExceptObject).Message);
MsgPtr := PKOLChar(Exception(ExceptObject).Message);
//MsgLen := StrLen(MsgPtr);
//if (MsgLen <> 0) and (MsgPtr[MsgLen - 1] <> '.') then MsgEnd := '.';
{-} // Isn't it too beautiful - devote ~40 bytes of code just to decide,
// add or not a point at the end of the message.
end;
{$IFNDEF USE_RESOURCESTRING}
StrCopy( Fmt, SException );
{$IFDEF UNICODE_CTRLS} WStrCopy {$ELSE} StrCopy {$ENDIF}( Fmt, SException );
{$ELSE}
LoadString(FindResourceHInstance(HInstance),
PResStringRec(@SException).Identifier, Fmt, SizeOf(Fmt));
{$ENDIF}
//MsgOK( ModuleName );
{$IFDEF UNICODE_CTRLS} WStrCopy {$ELSE} StrCopy {$ENDIF}
( Buffer, PKOLChar( Format( KOLString(Fmt), [ ExceptObject.ClassName,
( Buffer, PKOLChar( Format( Fmt, [ ExceptObject.ClassName,
ModuleName, ConvertedAddress, MsgPtr, '' {MsgEnd}]) ) );
Result := {$IFDEF UNICODE_CTRLS} WStrLen {$ELSE} StrLen {$ENDIF}(Buffer);
end;
@ -620,21 +619,21 @@ begin
FData := Value;
end;
constructor Exception.Create(ACode: TError; const Msg: AnsiString);
constructor Exception.Create(ACode: TError; const Msg: string);
begin
FCode := ACode;
FMessage := Msg;
//FAllowFree := TRUE;
end;
constructor Exception.CreateCustom(AError: DWORD; const Msg: AnsiString);
constructor Exception.CreateCustom(AError: DWORD; const Msg: String);
begin
FCode := e_Custom;
FMessage := Msg;
FErrorCode := AError;
end;
constructor Exception.CreateCustomFmt(AError: DWORD; const Msg: AnsiString;
constructor Exception.CreateCustomFmt(AError: DWORD; const Msg: String;
const Args: array of const);
begin
FCode := e_Custom;
@ -642,7 +641,7 @@ begin
FMessage := Format(Msg, Args);
end;
constructor Exception.CreateFmt(ACode: TError; const Msg: AnsiString;
constructor Exception.CreateFmt(ACode: TError; const Msg: string;
const Args: array of const);
begin
FCode := ACode;
@ -663,7 +662,7 @@ function CreateInOutError: Exception;
type
TErrorRec = record
Code: Integer;
Ident: AnsiString;
Ident: string;
end;
const
ErrorMap: array[0..5] of TErrorRec = (
@ -694,7 +693,7 @@ end;
type
TExceptMapRec = packed record
ECode: TError;
EIdent: AnsiString;
EIdent: String;
end;
const
@ -765,10 +764,10 @@ end;
{ routine RaiseAssertException sets up the registers just as if the user }
{ code itself had raised the exception. }
function CreateAssertException(const Message, Filename: AnsiString;
function CreateAssertException(const Message, Filename: string;
LineNumber: Integer): Exception;
var
S: AnsiString;
S: string;
begin
if Message <> '' then S := Message else S := SAssertionFailed;
Result := Exception.CreateFmt(e_Assertion, SAssertError,
@ -790,13 +789,13 @@ end;
{ If you change this procedure, make sure it does not have any local variables }
{ or temps that need cleanup - they won't get cleaned up due to the way }
{ RaiseAssertException frame works. Also, it can not have an exception frame. }
procedure AssertErrorHandler(const Message, Filename: AnsiString;
procedure AssertErrorHandler(const Message, Filename: string;
LineNumber: Integer; ErrorAddr: Pointer);
var
E: Exception;
begin
E := CreateAssertException(Message, Filename, LineNumber);
RaiseAssertException(E, ErrorAddr, PAnsiChar(@ErrorAddr)+4);
RaiseAssertException(E, ErrorAddr, PChar(@ErrorAddr)+4);
end;
{ Abstract method invoke error handler }
@ -891,7 +890,7 @@ var
function CreateAVObject: Exception;
var
AccessOp: AnsiString; // AnsiString ID indicating the access type READ or WRITE
AccessOp: string; // string ID indicating the access type READ or WRITE
AccessAddress: Pointer;
MemInfo: TMemoryBasicInformation;
ModName: array[0..MAX_PATH] of KOLChar;
@ -933,7 +932,7 @@ end;
procedure ExceptHandler(ExceptObject: TObject; ExceptAddr: Pointer); far;
begin
ShowException(ExceptObject, ExceptAddr);
Halt(1);
Halt(1);
end;
{+}