Delphi/pascalscript
Delphi/pascalscript
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

first preparation for new Delphi

Browse Source 
git-svn-id: http://code.remobjects.com/svn/pascalscript@66 5c9d2617-0215-0410-a2ee-e80e04d1c6d8
This commit is contained in:
carlokok 2008-08-01 11:23:09 +00:00
parent 2e51c2669c
commit 6bc21c4d3d
11 changed files with 1288 additions and 1177 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

164
Source/eDefines.inc
View File

@ -3,19 +3,19 @@
{type: Delphi include file }
{ }
{compiler: Borland Pascal 7, }
{ Delphi 1-7, Delphi 2005 for Win32 }
{ Delphi 1-7, 2005-2007 for Win32 }
{ Kylix 1-3, }
{ C++Builder 1-5 (Pascal Only) }
{ C++Builder 1-6, 2006-2007 }
{ Free Pascal Compiler 2.x }
{ }
{platforms: DOS, DPMI, Win16, Win32, Linux }
{platforms: DOS, DPMI, Win16, Win32, Win64, Linux, Mac OS X }
{ }
{author: mh@elitedev.com }
{date: 8/3/1997, last changed: 7/2/2002 for Delphi 7 and Kylix 3 }
{ }
{contents: Defines that can be flexibily used to determine the exact }
{ compiler version used. }
{ }
{(c)opyright elitedevelopments. all rights reserved. }
{(c)opyright elitedevelopments software. all rights reserved. }
{ http://www.elitedev.com }
{ }
{ Third Party component developers are encouraged to use the set of defines }
@ -43,6 +43,8 @@
{ DELPHI7 Delphi 7.0 }
{ DELPHI9 Delphi 2005 }
{ DELPHI2005 Delphi 2005 }
{ DELPHI2006 Delphi 2006 }
{ DELPHI2007 Delphi 2007 }
{ KYLIX1 Kylix 1.0 }
{ KYLIX2 Kylix 2.0 }
{ KYLIX3 Kylix 3.0 }
@ -61,12 +63,16 @@
{ DELPHI5UP Delphi 5.0 and above }
{ DELPHI6UP Delphi 6.0 and above }
{ DELPHI7UP Delphi 7.0 and above }
{ DELPHI9UP Delphi 9.0 and above }
{ DELPHI9UP Delphi 9.0 (2005) and above }
{ DELPHI10UP Delphi 10.0 (2006) and above }
{ DELPHI11UP Delphi 11.0 (2007) and above }
{ DELPHI2005UP Delphi 2005 and above }
{ DELPHI2006UP Delphi 2006 and above }
{ DELPHI2007UP Delphi 2007 and above }
{ KYLIX1UP Kylix 1.0 and above (any Kylix) }
{ KYLIX2UP Kylix 2.0 and above (any Kylix) }
{ KYLIX3UP Kylix 3.0 and above (any Kylix) }
{ CBUILDER1UP C++Builder 1.0 and above or Delphi 2 and above (any C++Builder) }
{ CBUILDER1UP C++Builder 1.0 and above or Delphi 2 and above }
{ CBUILDER3UP C++Builder 3.0 and above or Delphi 3.0 and above }
{ CBUILDER4UP C++Builder 4.0 and above or Delphi 4.0 and above }
{ CBUILDER5UP C++Builder 5.0 and above or Delphi 5.0 and above }
@ -89,6 +95,12 @@
{ CBUILDER_32BIT 32bit C++Builer's Pascal (but not Delphi) }
{ }
{ }
{ target cpu types }
{ }
{ CPU16 16bit Delphi or Borland Pascal }
{ CPU32 32bit Delphi or Free Pascal }
{ CPU64 64bit Free Pascal }
{ }
{ target platforms }
{ }
{ DOS any DOS (plain and DPMI) }
@ -98,10 +110,16 @@
{ MSWINDOWS any Windows platform }
{ WIN16 16bit Windows }
{ WIN32 32bit Windows }
{ WIN64 64bit Windows }
{ DOTNET .NET }
{ }
{ LINUX any Linux platform }
{ LINUX32 32bit Linux }
{ LINUX64 64bit Linux }
{ }
{ DARWIN Any Mac OS X }
{ DARWIN32 32bit Mac OS X }
{ DARWIN64 64bit Mac OS X }
{----------------------------------------------------------------------------}
{ defines for Borland Pascal 7.0 }
@ -109,6 +127,7 @@
{$DEFINE BP}
{$DEFINE BP7}
{$DEFINE 16BIT}
{$DEFINE CPU16}
{ defines for BP7 DOS real mode }
{$IFDEF MSDOS}
@ -140,6 +159,7 @@
{$DEFINE DELPHI_16BIT}
{$DEFINE WIN16}
{$DEFINE 16BIT}
{$DEFINE CPU16}
{$ENDIF}
{ defines for Delphi 2.0 }
@ -279,6 +299,7 @@
{$DEFINE VER140UP}
{$DEFINE DELPHI}
{$DEFINE DELPHI10}
{$DEFINE DELPHI10A}
{$DEFINE DELPHI2006}
{$DEFINE DELPHI1UP}
{$DEFINE DELPHI2UP}
@ -288,7 +309,6 @@
{$DEFINE DELPHI6UP}
{$DEFINE DELPHI7UP}
{$DEFINE DELPHI9UP}
{$DEFINE DELPHI10A}
{$DEFINE DELPHI10UP}
{$DEFINE DELPHI2005UP}
{$DEFINE DELPHI2006UP}
@ -305,16 +325,53 @@
{$UNDEF BDS4} // declared in VER180
{$DEFINE DELPHI10B}
{$DEFINE DELPHI10BUP}
{$DEFINE DELPHI11}
{$DEFINE DELPHI11UP}
{$DEFINE DELPHI2007}
{$DEFINE DELPHI2007UP}
{$DEFINE BDS5}
{$DEFINE BDS5UP}
{$ENDIF}
{ defines for Delphi 2008 }
{$IFDEF VER200}
{$DEFINE VER140UP}
{$DEFINE DELPHI}
{$DEFINE DELPHI12}
{$DEFINE DELPHI1UP}
{$DEFINE DELPHI2UP}
{$DEFINE DELPHI3UP}
{$DEFINE DELPHI4UP}
{$DEFINE DELPHI5UP}
{$DEFINE DELPHI6UP}
{$DEFINE DELPHI7UP}
{$DEFINE DELPHI9UP}
{$DEFINE DELPHI10UP}
{$DEFINE DELPHI11UP}
{$DEFINE DELPHI12UP}
{$DEFINE DELPHI2008}
{$DEFINE DELPHI2005UP}
{$DEFINE DELPHI2006UP}
{$DEFINE DELPHI2007UP}
{$DEFINE DELPHI2008UP}
{$DEFINE BDS}
{$DEFINE BDS6}
{$DEFINE BDS3UP}
{$DEFINE BDS4UP}
{$DEFINE BDS5UP}
{$DEFINE BDS6UP}
{$DEFINE BDS6}
{$DEFINE BDS6UP}
{$ENDIF}
{$IFDEF WIN32}
{$DEFINE MSWINDOWS} //not automatically defined for Delphi 2 thru 5
{$DEFINE 32BIT}
{$DEFINE CPU32}
{$ENDIF}
{$ENDIF MSWINDOWS}
@ -334,40 +391,69 @@
{$DEFINE CBUILDER_32BIT}
{$ENDIF}
{ defines for Kylix 1.0 thru 3.0 }
{$IFDEF LINUX}
{$IFNDEF FPC}
{$DEFINE VER140UP}
{ Kylix 1.0 thru 3.0 }
{$IFDEF LINUX}
{ Any Kylix }
{$DEFINE 32BIT}
{$DEFINE LINUX32}
{$DEFINE KYLIX_32BIT}
{$DEFINE KYLIX}
{$DEFINE KYLIX1UP}
{$DEFINE VER140UP}
{$IFDEF CONDITIONALEXPRESSIONS}
{$IF Declared(CompilerVersion)}
{ Any Kylix }
{$DEFINE 32BIT}
{$DEFINE LINUX32}
{$DEFINE KYLIX_32BIT}
{$DEFINE KYLIX}
{$DEFINE KYLIX1UP}
{ Kylix 2.0 }
{$IF Declared(RTLVersion) and (RTLVersion = 14.1)}
{$DEFINE KYLIX2}
{$DEFINE KYLIX1UP}
{$DEFINE KYLIX2UP}
{$IFEND}
{$IFDEF CONDITIONALEXPRESSIONS}
{$IF Declared(CompilerVersion)}
{ Kylix 3.0 - Delphi portion }
{$IF Declared(RTLVersion) and (RTLVersion = 14.5)}
{$DEFINE KYLIX3}
{$DEFINE KYLIX1UP}
{$DEFINE KYLIX2UP}
{$DEFINE KYLIX3UP}
{$IFEND}
{ Kylix 2.0 }
{$IF Declared(RTLVersion) and (RTLVersion = 14.1)}
{$DEFINE KYLIX2}
{$DEFINE KYLIX1UP}
{$DEFINE KYLIX2UP}
{$IFEND}
{ Kylix 1.0 }
{$ELSE}
{$DEFINE KYLIX1}
{$IFEND}
{$ENDIF CONDITIONALEXPRESSIONS}
{ Kylix 3.0 - Delphi portion }
{$IF Declared(RTLVersion) and (RTLVersion = 14.5)}
{$DEFINE KYLIX3}
{$DEFINE KYLIX1UP}
{$DEFINE KYLIX2UP}
{$DEFINE KYLIX3UP}
{$IFEND}
{$ENDIF LINUX}
{ Kylix 1.0 }
{$ELSE}
{$DEFINE KYLIX1}
{$IFEND}
{$ENDIF CONDITIONALEXPRESSIONS}
{$ENDIF LINUX}
{$ENDIF}
{ CPU }
{$IFDEF FPC}
{$IFDEF MSWINDOWS}
{$IFDEF CPU64}
{$DEFINE WIN64}
{$ENDIF}
{$ENDIF}
{$IFDEF LINUX}
{$IFDEF CPU32}
{$DEFINE LINUX32}
{$ENDIF}
{$IFDEF CPU64}
{$DEFINE LINUX64}
{$ENDIF}
{$ENDIF}
{$IFDEF DARWIN}
{$IFDEF CPU32}
{$DEFINE DARWIN32}
{$ENDIF}
{$IFDEF CPU64}
{$DEFINE DARWIN64}
{$ENDIF}
{$ENDIF}
{$ENDIF}

4
Source/uPSC_dll.pas
View File

@ -23,7 +23,7 @@ const
function DllExternalProc(Sender: TPSPascalCompiler; Decl: TPSParametersDecl; const OriginalName, FExternal: string): TPSRegProc;
function DllExternalProc(Sender: TPSPascalCompiler; Decl: TPSParametersDecl; const OriginalName, FExternal: tbtstring): TPSRegProc;
type
TDllCallingConvention = (clRegister
@ -56,7 +56,7 @@ begin
if (Result <> '') and (Result[Length(result)] = '"') then delete(result, length(result), 1);
end;
function DllExternalProc(Sender: TPSPascalCompiler; Decl: TPSParametersDecl; const OriginalName, FExternal: string): TPSRegProc;
function DllExternalProc(Sender: TPSPascalCompiler; Decl: TPSParametersDecl; const OriginalName, FExternal: tbtstring): TPSRegProc;
var
FuncName,
Name,

986
Source/uPSCompiler.pas
View File

File diff suppressed because it is too large Load Diff

212
Source/uPSComponent.pas
View File

@ -81,11 +81,11 @@ type
TIFPS3CEPlugins = class(TPSPlugins);
TPSOnGetNotVariant = function (Sender: TPSScript; const Name: string): Variant of object;
TPSOnSetNotVariant = procedure (Sender: TPSScript; const Name: string; V: Variant) of object;
TPSOnGetNotVariant = function (Sender: TPSScript; const Name: tbtstring): Variant of object;
TPSOnSetNotVariant = procedure (Sender: TPSScript; const Name: tbtstring; V: Variant) of object;
TPSCompOptions = set of (icAllowNoBegin, icAllowUnit, icAllowNoEnd, icBooleanShortCircuit);
TPSVerifyProc = procedure (Sender: TPSScript; Proc: TPSInternalProcedure; const Decl: string; var Error: Boolean) of object;
TPSVerifyProc = procedure (Sender: TPSScript; Proc: TPSInternalProcedure; const Decl: tbtstring; var Error: Boolean) of object;
TPSEvent = procedure (Sender: TPSScript) of object;
@ -93,13 +93,13 @@ type
TPSOnExecImport = procedure (Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter) of object;
{Script engine event function}
TPSOnNeedFile = function (Sender: TObject; const OrginFileName: string; var FileName, Output: string): Boolean of object;
TPSOnNeedFile = function (Sender: TObject; const OrginFileName: tbtstring; var FileName, Output: tbtstring): Boolean of object;
TPSOnProcessDirective = procedure (
Sender: TPSPreProcessor;
Parser: TPSPascalPreProcessorParser;
const Active: Boolean;
const DirectiveName, DirectiveParam: String;
const DirectiveName, DirectiveParam: tbtstring;
Var Continue: Boolean) of Object; // jgv
TPSScript = class(TComponent)
@ -120,7 +120,7 @@ type
RI: TPSRuntimeClassImporter;
FPlugins: TPSPlugins;
FPP: TPSPreProcessor;
FMainFileName: string;
FMainFileName: tbtstring;
FOnNeedFile: TPSOnNeedFile;
FUsePreProcessor: Boolean;
FDefines: TStrings;
@ -132,17 +132,17 @@ type
procedure SetScript(const Value: TStrings);
function GetCompMsg(i: Integer): TPSPascalCompilerMessage;
function GetCompMsgCount: Longint;
function GetAbout: string;
function ScriptUses(Sender: TPSPascalCompiler; const Name: string): Boolean;
function GetAbout: tbtstring;
function ScriptUses(Sender: TPSPascalCompiler; const Name: tbtstring): Boolean;
function GetExecErrorByteCodePosition: Cardinal;
function GetExecErrorCode: TIFError;
function GetExecErrorParam: string;
function GetExecErrorParam: tbtstring;
function GetExecErrorProcNo: Cardinal;
function GetExecErrorString: string;
function GetExecErrorString: tbtstring;
function GetExecErrorPosition: Cardinal;
function GetExecErrorCol: Cardinal;
function GetExecErrorRow: Cardinal;
function GetExecErrorFileName: string;
function GetExecErrorFileName: tbtstring;
procedure SetDefines(const Value: TStrings);
protected
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
@ -150,34 +150,34 @@ type
protected
//jgv move where private before - not very usefull
procedure OnLineEvent; virtual;
procedure SetMainFileName(const Value: string); virtual;
procedure SetMainFileName(const Value: tbtstring); virtual;
//--jgv new
function DoOnNeedFile (Sender: TObject; const OrginFileName: string; var FileName, Output: string): Boolean; virtual;
function DoOnUnknowUses (Sender: TPSPascalCompiler; const Name: string): Boolean; virtual; // return true if processed
function DoOnNeedFile (Sender: TObject; const OrginFileName: tbtstring; var FileName, Output: tbtstring): Boolean; virtual;
function DoOnUnknowUses (Sender: TPSPascalCompiler; const Name: tbtstring): Boolean; virtual; // return true if processed
procedure DoOnCompImport; virtual;
procedure DoOnCompile; virtual;
function DoVerifyProc (Sender: TPSScript; Proc: TPSInternalProcedure; const Decl: string): Boolean; virtual;
function DoVerifyProc (Sender: TPSScript; Proc: TPSInternalProcedure; const Decl: tbtstring): Boolean; virtual;
procedure DoOnExecImport (RunTimeImporter: TPSRuntimeClassImporter); virtual;
procedure DoOnExecute (RunTimeImporter: TPSRuntimeClassImporter); virtual;
procedure DoAfterExecute; virtual;
function DoOnGetNotificationVariant (const Name: string): Variant; virtual;
procedure DoOnSetNotificationVariant (const Name: string; V: Variant); virtual;
function DoOnGetNotificationVariant (const Name: tbtstring): Variant; virtual;
procedure DoOnSetNotificationVariant (const Name: tbtstring; V: Variant); virtual;
procedure DoOnProcessDirective (Sender: TPSPreProcessor;
Parser: TPSPascalPreProcessorParser;
const Active: Boolean;
const DirectiveName, DirectiveParam: String;
const DirectiveName, DirectiveParam: tbtstring;
Var Continue: Boolean); virtual;
procedure DoOnProcessUnknowDirective (Sender: TPSPreProcessor;
Parser: TPSPascalPreProcessorParser;
const Active: Boolean;
const DirectiveName, DirectiveParam: String;
const DirectiveName, DirectiveParam: tbtstring;
Var Continue: Boolean); virtual;
public
function FindNamedType(const Name: string): TPSTypeRec;
function FindNamedType(const Name: tbtstring): TPSTypeRec;
function FindBaseType(Bt: TPSBaseType): TPSTypeRec;
@ -197,9 +197,9 @@ type
property Running: Boolean read GetRunning;
procedure GetCompiled(var data: string);
procedure GetCompiled(var data: tbtstring);
procedure SetCompiled(const Data: string);
procedure SetCompiled(const Data: tbtstring);
property Comp: TPSPascalCompiler read FComp;
@ -209,13 +209,13 @@ type
property CompilerMessages[i: Longint]: TPSPascalCompilerMessage read GetCompMsg;
function CompilerErrorToStr(I: Longint): string;
function CompilerErrorToStr(I: Longint): tbtstring;
property ExecErrorCode: TIFError read GetExecErrorCode;
property ExecErrorParam: string read GetExecErrorParam;
property ExecErrorParam: tbtstring read GetExecErrorParam;
property ExecErrorToString: string read GetExecErrorString;
property ExecErrorToString: tbtstring read GetExecErrorString;
property ExecErrorProcNo: Cardinal read GetExecErrorProcNo;
@ -227,38 +227,38 @@ type
property ExecErrorCol: Cardinal read GetExecErrorCol;
property ExecErrorFileName: string read GetExecErrorFileName;
property ExecErrorFileName: tbtstring read GetExecErrorFileName;
function AddFunctionEx(Ptr: Pointer; const Decl: string; CallingConv: TDelphiCallingConvention): Boolean;
function AddFunctionEx(Ptr: Pointer; const Decl: tbtstring; CallingConv: TDelphiCallingConvention): Boolean;
function AddFunction(Ptr: Pointer; const Decl: string): Boolean;
function AddFunction(Ptr: Pointer; const Decl: tbtstring): Boolean;
function AddMethodEx(Slf, Ptr: Pointer; const Decl: string; CallingConv: TDelphiCallingConvention): Boolean;
function AddMethodEx(Slf, Ptr: Pointer; const Decl: tbtstring; CallingConv: TDelphiCallingConvention): Boolean;
function AddMethod(Slf, Ptr: Pointer; const Decl: string): Boolean;
function AddMethod(Slf, Ptr: Pointer; const Decl: tbtstring): Boolean;
function AddRegisteredVariable(const VarName, VarType: string): Boolean;
function AddNotificationVariant(const VarName: string): Boolean;
function AddRegisteredVariable(const VarName, VarType: tbtstring): Boolean;
function AddNotificationVariant(const VarName: tbtstring): Boolean;
function AddRegisteredPTRVariable(const VarName, VarType: string): Boolean;
function AddRegisteredPTRVariable(const VarName, VarType: tbtstring): Boolean;
function GetVariable(const Name: string): PIFVariant;
function GetVariable(const Name: tbtstring): PIFVariant;
function SetVarToInstance(const VarName: string; cl: TObject): Boolean;
function SetVarToInstance(const VarName: tbtstring; cl: TObject): Boolean;
procedure SetPointerToData(const VarName: string; Data: Pointer; aType: TIFTypeRec);
procedure SetPointerToData(const VarName: tbtstring; Data: Pointer; aType: TIFTypeRec);
function TranslatePositionPos(Proc, Position: Cardinal; var Pos: Cardinal; var fn: string): Boolean;
function TranslatePositionPos(Proc, Position: Cardinal; var Pos: Cardinal; var fn: tbtstring): Boolean;
function TranslatePositionRC(Proc, Position: Cardinal; var Row, Col: Cardinal; var fn: string): Boolean;
function TranslatePositionRC(Proc, Position: Cardinal; var Row, Col: Cardinal; var fn: tbtstring): Boolean;
function GetProcMethod(const ProcName: string): TMethod;
function GetProcMethod(const ProcName: tbtstring): TMethod;
function ExecuteFunction(const Params: array of Variant; const ProcName: string): Variant;
function ExecuteFunction(const Params: array of Variant; const ProcName: tbtstring): Variant;
published
property About: string read GetAbout stored false;
property About: tbtstring read GetAbout stored false;
property Script: TStrings read FScript write SetScript;
@ -280,7 +280,7 @@ type
property Plugins: TPSPlugins read FPlugins write FPlugins;
property MainFileName: string read FMainFileName write SetMainFileName;
property MainFileName: tbtstring read FMainFileName write SetMainFileName;
property UsePreProcessor: Boolean read FUsePreProcessor write FUsePreProcessor;
@ -306,18 +306,18 @@ type
private
FLine: Longint;
FFileNameHash: Longint;
FFileName: string;
procedure SetFileName(const Value: string);
FFileName: tbtstring;
procedure SetFileName(const Value: tbtstring);
public
property FileName: string read FFileName write SetFileName;
property FileName: tbtstring read FFileName write SetFileName;
property FileNameHash: Longint read FFileNameHash;
property Line: Longint read FLine write FLine;
end;
TPSOnLineInfo = procedure (Sender: TObject; const FileName: string; Position, Row, Col: Cardinal) of object;
TPSOnLineInfo = procedure (Sender: TObject; const FileName: tbtstring; Position, Row, Col: Cardinal) of object;
TPSScriptDebugger = class(TPSScript)
private
@ -329,7 +329,7 @@ type
function GetBreakPoint(I: Integer): TPSBreakPointInfo;
function GetBreakPointCount: Longint;
protected
procedure SetMainFileName(const Value: string); override;
procedure SetMainFileName(const Value: tbtstring); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
@ -344,19 +344,19 @@ type
procedure StepOver; virtual;
procedure SetBreakPoint(const Fn: string; Line: Longint);
procedure SetBreakPoint(const Fn: tbtstring; Line: Longint);
procedure ClearBreakPoint(const Fn: string; Line: Longint);
procedure ClearBreakPoint(const Fn: tbtstring; Line: Longint);
property BreakPointCount: Longint read GetBreakPointCount;
property BreakPoint[I: Longint]: TPSBreakPointInfo read GetBreakPoint;
function HasBreakPoint(const Fn: string; Line: Longint): Boolean;
function HasBreakPoint(const Fn: tbtstring; Line: Longint): Boolean;
procedure ClearBreakPoints;
function GetVarContents(const Name: string): string;
function GetVarContents(const Name: tbtstring): tbtstring;
published
property OnIdle: TNotifyEvent read FOnIdle write FOnIdle;
@ -412,17 +412,17 @@ const
RPS_UnknownIdentifier = 'Unknown Identifier';
RPS_NoScript = 'No script';
function MyGetVariant(Sender: TPSExec; const Name: string): Variant;
function MyGetVariant(Sender: TPSExec; const Name: tbtstring): Variant;
begin
Result := TPSScript (Sender.Id).DoOnGetNotificationVariant(Name);
end;
procedure MySetVariant(Sender: TPSExec; const Name: string; V: Variant);
procedure MySetVariant(Sender: TPSExec; const Name: tbtstring; V: Variant);
begin
TPSScript (Sender.Id).DoOnSetNotificationVariant(Name, V);
end;
function CompScriptUses(Sender: TPSPascalCompiler; const Name: string): Boolean;
function CompScriptUses(Sender: TPSPascalCompiler; const Name: tbtstring): Boolean;
begin
Result := TPSScript(Sender.ID).ScriptUses(Sender, Name);
end;
@ -435,7 +435,7 @@ begin
end;
end;
function CompExportCheck(Sender: TPSPascalCompiler; Proc: TPSInternalProcedure; const ProcDecl: string): Boolean;
function CompExportCheck(Sender: TPSPascalCompiler; Proc: TPSInternalProcedure; const ProcDecl: tbtstring): Boolean;
begin
Result := TPSScript(Sender.ID).DoVerifyProc (Sender.ID, Proc, ProcDecl);
end;
@ -445,7 +445,7 @@ procedure callObjectOnProcessDirective (
Sender: TPSPreProcessor;
Parser: TPSPascalPreProcessorParser;
const Active: Boolean;
const DirectiveName, DirectiveParam: String;
const DirectiveName, DirectiveParam: tbtstring;
Var Continue: Boolean);
begin
TPSScript (Sender.ID).DoOnProcessUnknowDirective(Sender, Parser, Active, DirectiveName, DirectiveParam, Continue);
@ -455,7 +455,7 @@ procedure callObjectOnProcessUnknowDirective (
Sender: TPSPreProcessor;
Parser: TPSPascalPreProcessorParser;
const Active: Boolean;
const DirectiveName, DirectiveParam: String;
const DirectiveName, DirectiveParam: tbtstring;
Var Continue: Boolean);
begin
TPSScript (Sender.ID).DoOnProcessDirective(Sender, Parser, Active, DirectiveName, DirectiveParam, Continue);
@ -497,12 +497,12 @@ end;
{ TPSScript }
function TPSScript.AddFunction(Ptr: Pointer;
const Decl: string): Boolean;
const Decl: tbtstring): Boolean;
begin
Result := AddFunctionEx(Ptr, Decl, cdRegister);
end;
function TPSScript.AddFunctionEx(Ptr: Pointer; const Decl: string;
function TPSScript.AddFunctionEx(Ptr: Pointer; const Decl: tbtstring;
CallingConv: TDelphiCallingConvention): Boolean;
var
P: TPSRegProc;
@ -517,7 +517,7 @@ begin
end;
function TPSScript.AddRegisteredVariable(const VarName,
VarType: string): Boolean;
VarType: tbtstring): Boolean;
var
FVar: TPSVar;
begin
@ -531,12 +531,12 @@ begin
end;
end;
function CENeedFile(Sender: TPSPreProcessor; const callingfilename: string; var FileName, Output: string): Boolean;
function CENeedFile(Sender: TPSPreProcessor; const callingfilename: tbtstring; var FileName, Output: tbtstring): Boolean;
begin
Result := TPSScript (Sender.ID).DoOnNeedFile(Sender.ID, CallingFileName, FileName, Output);
end;
procedure CompTranslateLineInfo(Sender: TPSPascalCompiler; var Pos, Row, Col: Cardinal; var Name: string);
procedure CompTranslateLineInfo(Sender: TPSPascalCompiler; var Pos, Row, Col: Cardinal; var Name: tbtstring);
var
res: TPSLineInfoResults;
begin
@ -552,7 +552,7 @@ end;
function TPSScript.Compile: Boolean;
var
i: Longint;
dta: string;
dta: tbtstring;
begin
FExec.Clear;
FExec.CMD_Err(erNoError);
@ -623,7 +623,7 @@ begin
end;
end;
function TPSScript.CompilerErrorToStr(I: Integer): string;
function TPSScript.CompilerErrorToStr(I: Integer): tbtstring;
begin
Result := CompilerMessages[i].MessageToString;
end;
@ -681,12 +681,12 @@ begin
DoAfterExecute;
end;
function TPSScript.GetAbout: string;
function TPSScript.GetAbout: tbtstring;
begin
Result := TPSExec.About;
end;
procedure TPSScript.GetCompiled(var data: string);
procedure TPSScript.GetCompiled(var data: tbtstring);
begin
if not FComp.GetOutput(Data) then
raise Exception.Create(RPS_ScriptNotCompiled);
@ -712,7 +712,7 @@ begin
Result := Exec.ExceptionCode;
end;
function TPSScript.GetExecErrorParam: string;
function TPSScript.GetExecErrorParam: tbtstring;
begin
Result := Exec.ExceptionString;
end;
@ -727,19 +727,19 @@ begin
Result := Exec.ExceptionProcNo;
end;
function TPSScript.GetExecErrorString: string;
function TPSScript.GetExecErrorString: tbtstring;
begin
Result := TIFErrorToString(Exec.ExceptionCode, Exec.ExceptionString);
end;
function TPSScript.GetVariable(const Name: string): PIFVariant;
function TPSScript.GetVariable(const Name: tbtstring): PIFVariant;
begin
Result := FExec.GetVar2(name);
end;
function TPSScript.LoadExec: Boolean;
var
s: string;
s: tbtstring;
begin
if (not FComp.GetOutput(s)) or (not FExec.LoadData(s)) then
begin
@ -755,7 +755,7 @@ begin
end;
function TPSScript.ScriptUses(Sender: TPSPascalCompiler;
const Name: string): Boolean;
const Name: tbtstring): Boolean;
var
i: Longint;
begin
@ -791,7 +791,7 @@ begin
end;
end;
procedure TPSScript.SetCompiled(const Data: string);
procedure TPSScript.SetCompiled(const Data: tbtstring);
var
i: Integer;
begin
@ -827,7 +827,7 @@ begin
raise Exception.Create(GetExecErrorString);
end;
function TPSScript.SetVarToInstance(const VarName: string; cl: TObject): Boolean;
function TPSScript.SetVarToInstance(const VarName: tbtstring; cl: TObject): Boolean;
var
p: PIFVariant;
begin
@ -846,12 +846,12 @@ end;
function TPSScript.AddMethod(Slf, Ptr: Pointer;
const Decl: string): Boolean;
const Decl: tbtstring): Boolean;
begin
Result := AddMethodEx(Slf, Ptr, Decl, cdRegister);
end;
function TPSScript.AddMethodEx(Slf, Ptr: Pointer; const Decl: string;
function TPSScript.AddMethodEx(Slf, Ptr: Pointer; const Decl: tbtstring;
CallingConv: TDelphiCallingConvention): Boolean;
var
P: TPSRegProc;
@ -877,7 +877,7 @@ end;
function TPSScript.GetExecErrorCol: Cardinal;
var
s: string;
s: tbtstring;
D1: Cardinal;
begin
if not TranslatePositionRC(Exec.ExceptionProcNo, Exec.ExceptionPos, D1, Result, s) then
@ -885,7 +885,7 @@ begin
end;
function TPSScript.TranslatePositionPos(Proc, Position: Cardinal;
var Pos: Cardinal; var fn: string): Boolean;
var Pos: Cardinal; var fn: tbtstring): Boolean;
var
D1, D2: Cardinal;
begin
@ -893,7 +893,7 @@ begin
end;
function TPSScript.TranslatePositionRC(Proc, Position: Cardinal;
var Row, Col: Cardinal; var fn: string): Boolean;
var Row, Col: Cardinal; var fn: tbtstring): Boolean;
var
d1: Cardinal;
begin
@ -904,7 +904,7 @@ end;
function TPSScript.GetExecErrorRow: Cardinal;
var
D1: Cardinal;
s: string;
s: tbtstring;
begin
if not TranslatePositionRC(Exec.ExceptionProcNo, Exec.ExceptionPos, Result, D1, s) then
Result := 0;
@ -918,17 +918,17 @@ begin
raise Exception.Create(RPS_NotRunning);
end;
function TPSScript.GetProcMethod(const ProcName: string): TMethod;
function TPSScript.GetProcMethod(const ProcName: tbtstring): TMethod;
begin
Result := FExec.GetProcAsMethodN(ProcName)
end;
procedure TPSScript.SetMainFileName(const Value: string);
procedure TPSScript.SetMainFileName(const Value: tbtstring);
begin
FMainFileName := Value;
end;
function TPSScript.GetExecErrorFileName: string;
function TPSScript.GetExecErrorFileName: tbtstring;
var
D1, D2: Cardinal;
begin
@ -936,7 +936,7 @@ begin
Result := '';
end;
procedure TPSScript.SetPointerToData(const VarName: string;
procedure TPSScript.SetPointerToData(const VarName: tbtstring;
Data: Pointer; aType: TIFTypeRec);
var
v: PIFVariant;
@ -951,7 +951,7 @@ begin
end;
function TPSScript.AddRegisteredPTRVariable(const VarName,
VarType: string): Boolean;
VarType: tbtstring): Boolean;
var
FVar: TPSVar;
begin
@ -972,7 +972,7 @@ begin
end;
function TPSScript.ExecuteFunction(const Params: array of Variant;
const ProcName: string): Variant;
const ProcName: tbtstring): Variant;
begin
if SuppressLoadData then
LoadExec;
@ -989,7 +989,7 @@ begin
Result := Exec.FindType2(Bt);
end;
function TPSScript.FindNamedType(const Name: string): TPSTypeRec;
function TPSScript.FindNamedType(const Name: tbtstring): TPSTypeRec;
begin
Result := Exec.GetTypeNo(Exec.GetType(Name));
end;
@ -1014,14 +1014,14 @@ begin
end;
end;
function TPSScript.AddNotificationVariant(const VarName: string): Boolean;
function TPSScript.AddNotificationVariant(const VarName: tbtstring): Boolean;
begin
Result := AddRegisteredVariable(VarName, '!NOTIFICATIONVARIANT');
end;
procedure TPSScript.DoOnProcessDirective(Sender: TPSPreProcessor;
Parser: TPSPascalPreProcessorParser; const Active: Boolean;
const DirectiveName, DirectiveParam: String; var Continue: Boolean);
const DirectiveName, DirectiveParam: tbtstring; var Continue: Boolean);
begin
If Assigned (OnProcessDirective) then
OnProcessDirective (Sender, Parser, Active, DirectiveName, DirectiveParam, Continue);
@ -1029,14 +1029,14 @@ end;
procedure TPSScript.DoOnProcessUnknowDirective(Sender: TPSPreProcessor;
Parser: TPSPascalPreProcessorParser; const Active: Boolean;
const DirectiveName, DirectiveParam: String; var Continue: Boolean);
const DirectiveName, DirectiveParam: tbtstring; var Continue: Boolean);
begin
If Assigned (OnProcessUnknowDirective) then
OnProcessUnknowDirective (Sender, Parser, Active, DirectiveName, DirectiveParam, Continue);
end;
function TPSScript.DoOnNeedFile(Sender: TObject;
const OrginFileName: string; var FileName, Output: string): Boolean;
const OrginFileName: tbtstring; var FileName, Output: tbtstring): Boolean;
begin
If Assigned (OnNeedFile) then
Result := OnNeedFile(Sender, OrginFileName, FileName, Output)
@ -1045,10 +1045,10 @@ begin
end;
function TPSScript.DoOnUnknowUses(Sender: TPSPascalCompiler;
const Name: string): Boolean;
const Name: tbtstring): Boolean;
var
lPrevAllowUnit: Boolean;
lData, lName: string;
lData, lName: tbtstring;
begin
if assigned(FOnFindUnknownFile) then begin
lName := Name;
@ -1100,7 +1100,7 @@ begin
end;
function TPSScript.DoVerifyProc(Sender: TPSScript;
Proc: TPSInternalProcedure; const Decl: string): Boolean;
Proc: TPSInternalProcedure; const Decl: tbtstring): Boolean;
begin
if Assigned(OnVerifyProc) then begin
Result := false;
@ -1118,14 +1118,14 @@ begin
OnExecImport(Self, FExec, RunTimeImporter);
end;
function TPSScript.DoOnGetNotificationVariant(const Name: string): Variant;
function TPSScript.DoOnGetNotificationVariant(const Name: tbtstring): Variant;
begin
if Not Assigned (OnGetNotificationVariant) then
raise Exception.Create(RPS_UnableToReadVariant);
Result := OnGetNotificationVariant(Self, Name);
end;
procedure TPSScript.DoOnSetNotificationVariant(const Name: string;
procedure TPSScript.DoOnSetNotificationVariant(const Name: tbtstring;
V: Variant);
begin
if Not Assigned (OnSetNotificationVariant) then
@ -1149,12 +1149,12 @@ end;
{ TPS3DebugCompExec }
procedure LineInfo(Sender: TPSDebugExec; const FileName: string; Position, Row, Col: Cardinal);
procedure LineInfo(Sender: TPSDebugExec; const FileName: tbtstring; Position, Row, Col: Cardinal);
var
Dc: TPSScriptDebugger;
h, i: Longint;
bi: TPSBreakPointInfo;
lFileName: string;
lFileName: tbtstring;
begin
Dc := Sender.Id;
if FileName = '' then
@ -1194,7 +1194,7 @@ begin
dc.Exec.Run;
end;
procedure TPSScriptDebugger.ClearBreakPoint(const Fn: string; Line: Integer);
procedure TPSScriptDebugger.ClearBreakPoint(const Fn: tbtstring; Line: Integer);
var
h, i: Longint;
bi: TPSBreakPointInfo;
@ -1251,11 +1251,11 @@ begin
Result := FBreakPoints.Count;
end;
function TPSScriptDebugger.GetVarContents(const Name: string): string;
function TPSScriptDebugger.GetVarContents(const Name: tbtstring): tbtstring;
var
i: Longint;
pv: PIFVariant;
s1, s: string;
s1, s: tbtstring;
begin
s := Uppercase(Name);
if pos('.', s) > 0 then
@ -1303,7 +1303,7 @@ begin
Result := PSVariantToString(NewTPSVariantIFC(pv, False), s);
end;
function TPSScriptDebugger.HasBreakPoint(const Fn: string; Line: Integer): Boolean;
function TPSScriptDebugger.HasBreakPoint(const Fn: tbtstring; Line: Integer): Boolean;
var
h, i: Longint;
bi: TPSBreakPointInfo;
@ -1337,7 +1337,7 @@ begin
raise Exception.Create(RPS_NotRunning);
end;
procedure TPSScriptDebugger.SetBreakPoint(const fn: string; Line: Integer);
procedure TPSScriptDebugger.SetBreakPoint(const fn: tbtstring; Line: Integer);
var
i, h: Longint;
BI: TPSBreakPointInfo;
@ -1355,9 +1355,9 @@ begin
bi.Line := Line;
end;
procedure TPSScriptDebugger.SetMainFileName(const Value: string);
procedure TPSScriptDebugger.SetMainFileName(const Value: tbtstring);
var
OldFn: string;
OldFn: tbtstring;
h1, h2,i: Longint;
bi: TPSBreakPointInfo;
begin
@ -1415,7 +1415,7 @@ end;
function TPSPluginItem.GetDisplayName: string;
begin
if FPlugin <> nil then
Result := FPlugin.Name
Result := string(FPlugin.Name)
else
Result := '<nil>';
end;
@ -1443,7 +1443,7 @@ end;
{ TPSBreakPointInfo }
procedure TPSBreakPointInfo.SetFileName(const Value: string);
procedure TPSBreakPointInfo.SetFileName(const Value: tbtstring);
begin
FFileName := Value;
FFileNameHash := MakeHash(Value);

126
Source/uPSComponentExt.pas
View File

@ -31,28 +31,28 @@ type
{Base class for all plugins for the component}
TPSOnCompCleanup = Function (Sender: TObject; aComp: TPSPascalCompiler):Boolean of object;
TPSOnInsertProcedure = Procedure (Sender: TObject; aProc: String; OnTop: Boolean) of object;
TPSOnException = procedure (Sender: TPSExec; ExError: TPSError; const ExParam: string;
TPSOnInsertProcedure = Procedure (Sender: TObject; aProc: tbtstring; OnTop: Boolean) of object;
TPSOnException = procedure (Sender: TPSExec; ExError: TPSError; const ExParam: tbtstring;
ExObject: TObject; ProcNo, Position: Cardinal) of object;
TMethodList = class;
TProcObj = Class
private
FName : String;
FName : tbtstring;
fOwner : TMethodList;
procedure SetName(const Value: String);
procedure SetName(const Value: tbtstring);
public
ProcType : TStringList;
Method : TMethod;
constructor create(aOwner: TMethodList);
destructor Destroy; override;
property Name: String read FName write SetName;
property Name: tbtstring read FName write SetName;
end;
TMethodObj = Class
Instance : TPersistent;
PropName : String;
ProcName : String;
PropName : tbtstring;
ProcName : tbtstring;
end;
TMethodList = class
@ -62,18 +62,18 @@ type
fEventList : TObjectList;
function GetObject(Index: Integer): TMethodObj; virtual;
function GetProcObj(Index: Integer): TProcObj;
function GetMethodName(Instance: TObject; PropName: String): String;
procedure SetMethodName(Instance: TObject; PropName: String; const Value: String);
procedure CreateProc(ProcName: string; aPropType: TTypeData);
function GetMethodName(Instance: TObject; PropName: tbtstring): tbtstring;
procedure SetMethodName(Instance: TObject; PropName: tbtstring; const Value: tbtstring);
procedure CreateProc(ProcName: tbtstring; aPropType: TTypeData);
public
constructor create(aOwner: TPSScriptExtension);
destructor Destroy; override;
function methodIndexOf(Instance: TObject; PropName: String):Integer;
Function ProcIndexOf(Name: String): Integer;
Procedure ListEventsName(EventType:string; List : TStrings);
function methodIndexOf(Instance: TObject; PropName: tbtstring):Integer;
Function ProcIndexOf(Name: tbtstring): Integer;
Procedure ListEventsName(EventType:tbtstring; List : TStrings);
Procedure AddProcedure(ProcName, ProcType:String);
procedure InsertMethod(NewProc: String; OnTop: Boolean = false);
Procedure AddProcedure(ProcName, ProcType:tbtstring);
procedure InsertMethod(NewProc: tbtstring; OnTop: Boolean = false);
Procedure FillMethods;
procedure ClearProcList;
@ -82,7 +82,7 @@ type
Function MethodCount :Integer;
property Procs[Index: Integer]: TProcObj read GetProcObj ;
property Methods[Index: Integer]: TMethodObj read GetObject;
property ProcName[Instance: TObject; PropName:String]: String read GetMethodName write SetMethodName;
property ProcName[Instance: TObject; PropName:tbtstring]: tbtstring read GetMethodName write SetMethodName;
end;
TPSScriptExtension = class(TPSScriptDebugger)
@ -96,17 +96,17 @@ type
fItems, fInserts: TStrings;
fScriptPos : Cardinal;
fObjectNest: STring;
fObjectNest: tbtstring;
Procedure GetCodeProps ;
function GetProcName(Instance: TObject; PropName: String): string;
procedure SetProcName(Instance: TObject; PropName: String; const Value: string);
function GetProcName(Instance: TObject; PropName: tbtstring): tbtstring;
procedure SetProcName(Instance: TObject; PropName: tbtstring; const Value: tbtstring);
protected
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure DoVerifyProc(Sender: TPSScript; Proc: TPSInternalProcedure;
const Decl: string; var Error: Boolean); reintroduce;
const Decl: tbtstring; var Error: Boolean); reintroduce;
Function DoBeforeCleanup(Sender: TObject; aComp: TPSPascalCompiler):Boolean;
procedure DoScriptChance(sender:TObject);
@ -120,7 +120,7 @@ type
function Compile: Boolean; Override;
function Execute: Boolean; Override;
{ Create a list of all var's, const's, Type's and functions }
Procedure GetValueDefs(aItems, aInserts: TStrings; Const aObjectNest: String=''; aScriptPos: Integer = 0);
Procedure GetValueDefs(aItems, aInserts: TStrings; Const aObjectNest: tbtstring=''; aScriptPos: Integer = 0);
{Compile the source only when the source is modified}
procedure CompileIfNeeded;
@ -140,7 +140,7 @@ type
Instance is the object where the Propname must be set.
You need te create the function yopur self in the script.
When the new Procname dose not exists in the script, it is automatic created for you.}
property ProcName[Instance: TObject; PropName:String]: string read GetProcName write SetProcName;
property ProcName[Instance: TObject; PropName:tbtstring]: tbtstring read GetProcName write SetProcName;
property MethodList : TMethodList read FMethodList;
published
@ -158,7 +158,7 @@ resourcestring
sMissingEndStatment = 'Missing some ''End'' statments';
function CompExportCheck(Sender: TPSPascalCompiler; Proc: TPSInternalProcedure; const ProcDecl: string): Boolean;
function CompExportCheck(Sender: TPSPascalCompiler; Proc: TPSInternalProcedure; const ProcDecl: tbtstring): Boolean;
begin
TPSScriptExtension(Sender.ID).DoVerifyProc(Sender.Id, Proc, ProcDecl, Result);
Result := not Result;
@ -169,7 +169,7 @@ begin
result := TPSScriptExtension(Sender.ID).DoBeforeCleanUp(Sender.ID,Sender);
end;
procedure CEException(Sender: TPSExec; ExError: TIFError; const ExParam: string; ExObject: TObject; ProcNo, Position: Cardinal);
procedure CEException(Sender: TPSExec; ExError: TIFError; const ExParam: tbtstring; ExObject: TObject; ProcNo, Position: Cardinal);
begin
if @TPSScriptExtension(Sender.ID).FOnException <> nil then
TPSScriptExtension(Sender.ID).FOnException(Sender, ExError, ExParam, ExObject, ProcNo, Position);
@ -208,7 +208,7 @@ begin
end;
procedure TPSScriptExtension.DoVerifyProc(Sender: TPSScript;
Proc: TPSInternalProcedure; const Decl: string; var Error: Boolean);
Proc: TPSInternalProcedure; const Decl: tbtstring; var Error: Boolean);
var
n{,m,p} : Integer;
tstType : TPSProceduralType;
@ -232,16 +232,16 @@ end;
type
TMyPascalCompiler = class(TPSPascalCompiler);
const
sIFPSParameterMode : array [pmIn..pmInOut] of string = ('','\style{+B}out\style{-B} ','\style{+B}Var\style{-B} ');
sIFPSParameterMode : array [pmIn..pmInOut] of tbtstring = ('','\style{+B}out\style{-B} ','\style{+B}Var\style{-B} ');
Procedure TPSScriptExtension.GetCodeProps;
Function existsItem(aName:String):Boolean;
Function existsItem(aName:tbtstring):Boolean;
Begin
result := FInserts.indexof(aName)<> -1;
end;
Procedure addListItem(aType, aName:String; aDef:String='');
Procedure addListItem(aType, aName:tbtstring; aDef:tbtstring='');
var
x : LongInt;
begin
@ -251,7 +251,7 @@ Procedure TPSScriptExtension.GetCodeProps;
end;
end;
procedure Getdecl(decl : TPSParametersDecl; var T,v :string);
procedure Getdecl(decl : TPSParametersDecl; var T,v :tbtstring);
var
m : Integer;
begin
@ -271,15 +271,15 @@ Procedure TPSScriptExtension.GetCodeProps;
end;
Function getTypeDef(xr: TPSType; aZoek:string = ''):Boolean; forward;
Function getTypeDef(xr: TPSType; aZoek:tbtstring = ''):Boolean; forward;
Function getClassDef(xc: TPSCompileTimeClass; aZoek:string = ''):Boolean;
Function getClassDef(xc: TPSCompileTimeClass; aZoek:tbtstring = ''):Boolean;
var
Show : Boolean;
Zoek,bZoek : String;
Zoek,bZoek : tbtstring;
tci : TPSDelphiClassItem;
n : Integer;
T,v : String;
T,v : tbtstring;
begin
Show := aZoek='';
@ -321,10 +321,10 @@ Procedure TPSScriptExtension.GetCodeProps;
end;
end;
Function getTypeDef(xr: TPSType; aZoek:string = ''):Boolean;
Function getTypeDef(xr: TPSType; aZoek:tbtstring = ''):Boolean;
var
Show : Boolean;
Zoek : String;
Zoek : tbtstring;
xri : PIFPSRecordFieldTypeDef;
n : Integer;
begin
@ -353,15 +353,15 @@ Procedure TPSScriptExtension.GetCodeProps;
end;
end;
Function FindVarProc(aVarName:string; aZoek : string= ''):Boolean;
Function FindVarProc(aVarName:tbtstring; aZoek : tbtstring= ''):Boolean;
var
// cv : String;
// cv : tbtstring;
hh, h, i : Longint;
proc : TPSProcedure;
ip : TPSInternalProcedure;
ipv : PIFPSProcVar;
ipp : TPSParameterDecl;
// t : String;
// t : tbtstring;
begin
Hh := MakeHash(aVarName);
result := False;
@ -395,13 +395,13 @@ Procedure TPSScriptExtension.GetCodeProps;
end;
end;
Function FindVarFunctType(aProcName:string): Boolean;
Function FindVarFunctType(aProcName:tbtstring): Boolean;
var
cv : String;
cv : tbtstring;
h, i : Longint;
proc : TPSProcedure;
xr : TPSRegProc;
// t : String;
// t : tbtstring;
begin
cv := aProcName;
If Pos('.',aProcName)>0 then begin
@ -441,7 +441,7 @@ Procedure TPSScriptExtension.GetCodeProps;
Var
n : Integer;
s, t, v : String;
s, t, v : tbtstring;
proc : TPSProcedure;
xr : TPSRegProc;
@ -494,7 +494,7 @@ begin
end;
end;
procedure TPSScriptExtension.GetValueDefs(aItems, aInserts: TStrings; const aObjectNest: STring; aScriptPos: Integer);
procedure TPSScriptExtension.GetValueDefs(aItems, aInserts: TStrings; const aObjectNest: tbtstring; aScriptPos: Integer);
begin
fItems := aItems;
fInserts := aInserts;
@ -552,12 +552,12 @@ begin
end;
end;
function TPSScriptExtension.GetProcName(Instance: TObject; PropName: String): string;
function TPSScriptExtension.GetProcName(Instance: TObject; PropName: tbtstring): tbtstring;
begin
Result := MethodList.ProcName[Instance, Propname];
end;
procedure TPSScriptExtension.SetProcName(Instance: TObject; PropName: String; const Value: string);
procedure TPSScriptExtension.SetProcName(Instance: TObject; PropName: tbtstring; const Value: tbtstring);
begin
MethodList.ProcName[Instance, Propname] := Value;
end;
@ -579,7 +579,7 @@ end;
{ TMethodList }
procedure TMethodList.AddProcedure(ProcName, ProcType: String);
procedure TMethodList.AddProcedure(ProcName, ProcType: tbtstring);
var
po : TProcObj;
x,y : Integer;
@ -611,9 +611,9 @@ begin
fEventList := TObjectList.create(true);
end;
procedure TMethodList.CreateProc(ProcName:String; aPropType: TTypeData);
procedure TMethodList.CreateProc(ProcName:tbtstring; aPropType: TTypeData);
var
newProc: string;
newProc: tbtstring;
P: PByte;
i: Integer;
pf : TParamFlags;
@ -671,16 +671,16 @@ begin
end;
end;
procedure TMethodList.InsertMethod(NewProc: String; OnTop: Boolean = false);
procedure TMethodList.InsertMethod(NewProc: tbtstring; OnTop: Boolean = false);
var
x : Integer;
sl : TStringList;
nBegins : Integer;
nProcs : Integer;
line, test : String;
line, test : tbtstring;
function IsItem(line,item:String; First :Boolean = false):Boolean;
function IsItem(line,item:tbtstring; First :Boolean = false):Boolean;
var
nPos : Integer;
begin
@ -692,7 +692,7 @@ var
until (Result) or (nPos = 0);
end;
function DelSpaces(AText: String): String;
function DelSpaces(AText: tbtstring): tbtstring;
var i: Integer;
begin
Result := '';
@ -701,12 +701,12 @@ var
Result := Result + AText[i];
end;
function IsProcDecl(AnOriginalProcDecl: String): Boolean;
function IsProcDecl(AnOriginalProcDecl: tbtstring): Boolean;
var
bIsFunc: Boolean;
iLineNo: Integer;
sProcKey: String;
sProcDecl: String;
sProcKey: tbtstring;
sProcDecl: tbtstring;
begin
Result := false;
sProcDecl := Line;
@ -821,7 +821,7 @@ begin
end;
end;
function TMethodList.GetMethodName(Instance: TObject; PropName: String): String;
function TMethodList.GetMethodName(Instance: TObject; PropName: tbtstring): tbtstring;
var
x : Integer;
begin
@ -841,7 +841,7 @@ begin
result := TProcObj(fProcList.items[Index]);
end;
procedure TMethodList.ListEventsName(EventType: string; List: TStrings);
procedure TMethodList.ListEventsName(EventType: tbtstring; List: TStrings);
var
x : Integer;
begin
@ -861,7 +861,7 @@ begin
end;
function TMethodList.methodIndexOf(Instance: TObject;
PropName: String): Integer;
PropName: tbtstring): Integer;
var x : integer;
begin
Result := -1;
@ -879,7 +879,7 @@ begin
result := fProcList.count;
end;
function TMethodList.ProcIndexOf(Name: String): Integer;
function TMethodList.ProcIndexOf(Name: tbtstring): Integer;
var x : integer;
begin
result := -1;
@ -892,12 +892,12 @@ begin
end;
end;
procedure TMethodList.SetMethodName(Instance: TObject; PropName: String;
const Value: String);
procedure TMethodList.SetMethodName(Instance: TObject; PropName: tbtstring;
const Value: tbtstring);
var
x, y : Integer;
mo : TMethodObj;
function TypeData(Instance: TObject; const PropName: string):PTypeData;
function TypeData(Instance: TObject; const PropName: tbtstring):PTypeData;
var
PropInfo: PPropInfo;
begin
@ -982,7 +982,7 @@ begin
inherited;
end;
procedure TProcObj.SetName(const Value: String);
procedure TProcObj.SetName(const Value: tbtstring);
var
x : Integer;
begin

24
Source/uPSDebugger.pas
View File

@ -21,7 +21,7 @@ type
FProcNames: TIFStringList;
FGlobalVarNames: TIfStringList;
FCurrentSourcePos, FCurrentRow, FCurrentCol: Cardinal;
FCurrentFile: string;
FCurrentFile: tbtstring;
function GetCurrentProcParams: TIfStringList;
@ -37,9 +37,9 @@ type
function TranslatePosition(Proc, Position: Cardinal): Cardinal;
function TranslatePositionEx(Proc, Position: Cardinal; var Pos, Row, Col: Cardinal; var Fn: string): Boolean;
function TranslatePositionEx(Proc, Position: Cardinal; var Pos, Row, Col: Cardinal; var Fn: tbtstring): Boolean;
procedure LoadDebugData(const Data: string);
procedure LoadDebugData(const Data: tbtstring);
procedure Clear; override;
@ -63,7 +63,7 @@ type
end;
TPSDebugExec = class;
TOnSourceLine = procedure (Sender: TPSDebugExec; const Name: string; Position, Row, Col: Cardinal);
TOnSourceLine = procedure (Sender: TPSDebugExec; const Name: tbtstring; Position, Row, Col: Cardinal);
TOnIdleCall = procedure (Sender: TPSDebugExec);
@ -83,7 +83,7 @@ type
public
constructor Create;
function LoadData(const s: string): Boolean; override;
function LoadData(const s: tbtstring): Boolean; override;
procedure Pause; override;
@ -118,7 +118,7 @@ const
type
PPositionData = ^TPositionData;
TPositionData = packed record
FileName: string;
FileName: tbtstring;
Position,
Row,
Col,
@ -271,10 +271,10 @@ begin
REsult := c;
end;
procedure TPSCustomDebugExec.LoadDebugData(const Data: string);
procedure TPSCustomDebugExec.LoadDebugData(const Data: tbtstring);
var
CP, I: Longint;
c: char;
c: tbtchar;
CurrProcNo, LastProcNo: Cardinal;
LastProc: PFunctionInfo;
NewLoc: PPositionData;
@ -429,21 +429,21 @@ end;
function TPSCustomDebugExec.TranslatePosition(Proc, Position: Cardinal): Cardinal;
var
D1, D2: Cardinal;
s: string;
s: tbtstring;
begin
if not TranslatePositionEx(Proc, Position, Result, D1, D2, s) then
Result := 0;
end;
function TPSCustomDebugExec.TranslatePositionEx(Proc, Position: Cardinal;
var Pos, Row, Col: Cardinal; var Fn: string): Boolean;
var Pos, Row, Col: Cardinal; var Fn: tbtstring): Boolean;
// Made by Martijn Laan (mlaan@wintax.nl)
var
i: LongInt;
fi: PFunctionInfo;
pt: TIfList;
r: PPositionData;
lastfn: string;
lastfn: tbtstring;
LastPos, LastRow, LastCol: Cardinal;
pp: TPSProcRec;
begin
@ -507,7 +507,7 @@ begin
FDebugMode := dmRun;
end;
function TPSDebugExec.LoadData(const s: string): Boolean;
function TPSDebugExec.LoadData(const s: tbtstring): Boolean;
begin
Result := inherited LoadData(s);
FDebugMode := dmRun;

50
Source/uPSPreProcessor.pas
View File

@ -13,12 +13,12 @@ type
TPSPreProcessor = class;
TPSPascalPreProcessorParser = class;
TPSOnNeedFile = function (Sender: TPSPreProcessor; const callingfilename: string; var FileName, Output: string): Boolean;
TPSOnNeedFile = function (Sender: TPSPreProcessor; const callingfilename: tbtstring; var FileName, Output: tbtstring): Boolean;
TPSOnProcessDirective = procedure (
Sender: TPSPreProcessor;
Parser: TPSPascalPreProcessorParser;
const Active: Boolean;
const DirectiveName, DirectiveParam: String;
const DirectiveName, DirectiveParam: tbtString;
Var Continue: Boolean); //- jgv - application set continue to false to stop the normal directive processing
TPSLineInfo = class(TObject)
@ -28,12 +28,12 @@ type
protected
FEndPos: Cardinal;
FStartPos: Cardinal;
FFileName: string;
FFileName: tbtstring;
FLineOffsets: TIfList;
public
property FileName: string read FFileName;
property FileName: tbtstring read FFileName;
property StartPos: Cardinal read FStartPos;
property EndPos: Cardinal read FEndPos;
@ -54,7 +54,7 @@ type
Col,
Pos: Cardinal;
Name: string;
Name: tbtstring;
end;
TPSLineInfoList = class(TObject)
@ -74,7 +74,7 @@ type
procedure Clear;
function GetLineInfo(const ModuleName: string; Pos: Cardinal; var Res: TPSLineInfoResults): Boolean;
function GetLineInfo(const ModuleName: tbtstring; Pos: Cardinal; var Res: TPSLineInfoResults): Boolean;
property Current: Longint read FCurrent write FCurrent;
@ -94,12 +94,12 @@ type
FAddedPosition: Cardinal;
FDefineState: TPSDefineStates;
FMaxLevel: Longint;
FMainFileName: string;
FMainFile: string;
FMainFileName: tbtstring;
FMainFile: tbtstring;
FOnProcessDirective: TPSOnProcessDirective;
FOnProcessUnknowDirective: TPSOnProcessDirective;
procedure ParserNewLine(Sender: TPSPascalPreProcessorParser; Row, Col, Pos: Cardinal);
procedure IntPreProcess(Level: Integer; const OrgFileName: string; FileName: string; Dest: TStream);
procedure IntPreProcess(Level: Integer; const OrgFileName: tbtstring; FileName: tbtstring; Dest: TStream);
protected
procedure doAddStdPredefines; virtual; // jgv
public
@ -111,16 +111,16 @@ type
property Defines: TStringList read FDefines write FDefines;
property MainFile: string read FMainFile write FMainFile;
property MainFile: tbtstring read FMainFile write FMainFile;
property MainFileName: string read FMainFileName write FMainFileName;
property MainFileName: tbtstring read FMainFileName write FMainFileName;
property ID: Pointer read FID write FID;
procedure AdjustMessages(Comp: TPSPascalCompiler);
procedure AdjustMessage(Msg: TPSPascalCompilerMessage); //-jgv
procedure PreProcess(const Filename: string; var Output: string);
procedure PreProcess(const Filename: tbtstring; var Output: tbtstring);
procedure Clear;
@ -139,19 +139,19 @@ type
TPSPascalPreProcessorParser = class(TObject)
private
FData: string;
FData: tbtstring;
FText: Pchar;
FToken: string;
FToken: tbtstring;
FTokenId: TPSPascalPreProcessorType;
FLastEnterPos, FLen, FRow, FCol, FPos: Cardinal;
FOnNewLine: TPSOnNewLine;
public
procedure SetText(const dta: string);
procedure SetText(const dta: tbtstring);
procedure Next;
property Token: string read FToken;
property Token: tbtstring read FToken;
property TokenId: TPSPascalPreProcessorType read FTokenId;
@ -258,12 +258,12 @@ begin
Result := TPSLineInfo(FItems[i]);
end;
function TPSLineInfoList.GetLineInfo(const ModuleName: string; Pos: Cardinal; var Res: TPSLineInfoResults): Boolean;
function TPSLineInfoList.GetLineInfo(const ModuleName: tbtstring; Pos: Cardinal; var Res: TPSLineInfoResults): Boolean;
var
i,j: Longint;
linepos: Cardinal;
Item: TPSLineInfo;
lModuleName: string;
lModuleName: tbtstring;
begin
lModuleName := FastUpperCase(lModuleName);
@ -472,7 +472,7 @@ begin
FToken := Copy(FData, FPos +1, FLen);
end;
procedure TPSPascalPreProcessorParser.SetText(const dta: string);
procedure TPSPascalPreProcessorParser.SetText(const dta: tbtstring);
begin
FData := dta;
FText := pchar(FData);
@ -554,12 +554,12 @@ begin
{$ENDIF }
end;
procedure TPSPreProcessor.IntPreProcess(Level: Integer; const OrgFileName: string; FileName: string; Dest: TStream);
procedure TPSPreProcessor.IntPreProcess(Level: Integer; const OrgFileName: tbtstring; FileName: tbtstring; Dest: TStream);
var
Parser: TPSPascalPreProcessorParser;
dta: string;
dta: tbtstring;
item: TPSLineInfo;
s, name: string;
s, name: tbtstring;
current, i: Longint;
ds: TPSDefineState;
AppContinue: Boolean;
@ -702,7 +702,7 @@ begin
end;
end;
procedure TPSPreProcessor.PreProcess(const Filename: string; var Output: string);
procedure TPSPreProcessor.PreProcess(const Filename: tbtstring; var Output: tbtstring);
var
Stream: TMemoryStream;
begin

186
Source/uPSR_DB.pas
View File

@ -2,7 +2,7 @@
Unit uPSR_DB;
{$I PascalScript.inc}
Interface
Uses uPSRuntime;
Uses uPSRuntime, uPSUtils, SysUtils;
procedure RIRegisterTDATASET(Cl: TPSRuntimeClassImporter);
procedure RIRegisterTPARAMS(Cl: TPSRuntimeClassImporter);
@ -232,10 +232,10 @@ begin Self.FILTERED := T; end;
procedure TDATASETFILTERED_R(Self: TDATASET; var T: BOOLEAN);
begin T := Self.FILTERED; end;
procedure TDATASETFILTER_W(Self: TDATASET; const T: STRING);
procedure TDATASETFILTER_W(Self: TDATASET; const T: tbtstring);
begin Self.FILTER := T; end;
procedure TDATASETFILTER_R(Self: TDATASET; var T: STRING);
procedure TDATASETFILTER_R(Self: TDATASET; var T: tbtstring);
begin T := Self.FILTER; end;
procedure TDATASETSTATE_R(Self: TDATASET; var T: TDATASETSTATE);
@ -280,10 +280,10 @@ begin T := Self.ISUNIDIRECTIONAL; end;
procedure TDATASETFOUND_R(Self: TDATASET; var T: BOOLEAN);
begin T := Self.FOUND; end;
procedure TDATASETFIELDVALUES_W(Self: TDATASET; const T: VARIANT; const t1: STRING);
procedure TDATASETFIELDVALUES_W(Self: TDATASET; const T: VARIANT; const t1: tbtstring);
begin Self.FIELDVALUES[t1] := T; end;
procedure TDATASETFIELDVALUES_R(Self: TDATASET; var T: VARIANT; const t1: STRING);
procedure TDATASETFIELDVALUES_R(Self: TDATASET; var T: VARIANT; const t1: tbtstring);
begin T := Self.FIELDVALUES[t1]; end;
procedure TDATASETFIELDS_R(Self: TDATASET; var T: TFIELDS);
@ -357,10 +357,10 @@ begin T := Self.CANMODIFY; end;
procedure TDATASETBOF_R(Self: TDATASET; var T: BOOLEAN);
begin T := Self.BOF; end;
procedure TPARAMSPARAMVALUES_W(Self: TPARAMS; const T: VARIANT; const t1: STRING);
procedure TPARAMSPARAMVALUES_W(Self: TPARAMS; const T: VARIANT; const t1: tbtstring);
begin Self.PARAMVALUES[t1] := T; end;
procedure TPARAMSPARAMVALUES_R(Self: TPARAMS; var T: VARIANT; const t1: STRING);
procedure TPARAMSPARAMVALUES_R(Self: TPARAMS; var T: VARIANT; const t1: tbtstring);
begin T := Self.PARAMVALUES[t1]; end;
procedure TPARAMSITEMS_W(Self: TPARAMS; const T: TPARAM; const t1: INTEGER);
@ -390,10 +390,10 @@ begin Self.PARAMTYPE := T; end;
procedure TPARAMPARAMTYPE_R(Self: TPARAM; var T: TPARAMTYPE);
begin T := Self.PARAMTYPE; end;
procedure TPARAMNAME_W(Self: TPARAM; const T: STRING);
procedure TPARAMNAME_W(Self: TPARAM; const T: tbtstring);
begin Self.NAME := T; end;
procedure TPARAMNAME_R(Self: TPARAM; var T: STRING);
procedure TPARAMNAME_R(Self: TPARAM; var T: tbtstring);
begin T := Self.NAME; end;
{$IFDEF DELPHI6UP}
@ -417,16 +417,16 @@ begin Self.DATATYPE := T; end;
procedure TPARAMDATATYPE_R(Self: TPARAM; var T: TFIELDTYPE);
begin T := Self.DATATYPE; end;
procedure TPARAMTEXT_W(Self: TPARAM; const T: STRING);
procedure TPARAMTEXT_W(Self: TPARAM; const T: tbtstring);
begin Self.TEXT := T; end;
procedure TPARAMTEXT_R(Self: TPARAM; var T: STRING);
procedure TPARAMTEXT_R(Self: TPARAM; var T: tbtstring);
begin T := Self.TEXT; end;
procedure TPARAMNATIVESTR_W(Self: TPARAM; const T: STRING);
procedure TPARAMNATIVESTR_W(Self: TPARAM; const T: tbtstring);
begin Self.NATIVESTR := T; end;
procedure TPARAMNATIVESTR_R(Self: TPARAM; var T: STRING);
procedure TPARAMNATIVESTR_R(Self: TPARAM; var T: tbtstring);
begin T := Self.NATIVESTR; end;
procedure TPARAMISNULL_R(Self: TPARAM; var T: BOOLEAN);
@ -450,16 +450,16 @@ begin Self.ASTIME := T; end;
procedure TPARAMASTIME_R(Self: TPARAM; var T: TDATETIME);
begin T := Self.ASTIME; end;
procedure TPARAMASSTRING_W(Self: TPARAM; const T: STRING);
procedure TPARAMASSTRING_W(Self: TPARAM; const T: tbtstring);
begin Self.ASSTRING := T; end;
procedure TPARAMASSTRING_R(Self: TPARAM; var T: STRING);
procedure TPARAMASSTRING_R(Self: TPARAM; var T: tbtstring);
begin T := Self.ASSTRING; end;
procedure TPARAMASMEMO_W(Self: TPARAM; const T: STRING);
procedure TPARAMASMEMO_W(Self: TPARAM; const T: tbtstring);
begin Self.ASMEMO := T; end;
procedure TPARAMASMEMO_R(Self: TPARAM; var T: STRING);
procedure TPARAMASMEMO_R(Self: TPARAM; var T: tbtstring);
begin T := Self.ASMEMO; end;
procedure TPARAMASSMALLINT_W(Self: TPARAM; const T: LONGINT);
@ -525,10 +525,10 @@ begin Self.ASBCD := T; end;
procedure TPARAMASBCD_R(Self: TPARAM; var T: CURRENCY);
begin T := Self.ASBCD; end;
procedure TREFERENCEFIELDREFERENCETABLENAME_W(Self: TREFERENCEFIELD; const T: STRING);
procedure TREFERENCEFIELDREFERENCETABLENAME_W(Self: TREFERENCEFIELD; const T: tbtstring);
begin Self.REFERENCETABLENAME := T; end;
procedure TREFERENCEFIELDREFERENCETABLENAME_R(Self: TREFERENCEFIELD; var T: STRING);
procedure TREFERENCEFIELDREFERENCETABLENAME_R(Self: TREFERENCEFIELD; var T: tbtstring);
begin T := Self.REFERENCETABLENAME; end;
@ -541,10 +541,10 @@ begin T := Self.INCLUDEOBJECTFIELD; end;
procedure TDATASETFIELDNESTEDDATASET_R(Self: TDATASETFIELD; var T: TDATASET);
begin T := Self.NESTEDDATASET; end;
procedure TOBJECTFIELDOBJECTTYPE_W(Self: TOBJECTFIELD; const T: STRING);
procedure TOBJECTFIELDOBJECTTYPE_W(Self: TOBJECTFIELD; const T: tbtstring);
begin Self.OBJECTTYPE := T; end;
procedure TOBJECTFIELDOBJECTTYPE_R(Self: TOBJECTFIELD; var T: STRING);
procedure TOBJECTFIELDOBJECTTYPE_R(Self: TOBJECTFIELD; var T: tbtstring);
begin T := Self.OBJECTTYPE; end;
procedure TOBJECTFIELDUNNAMED_R(Self: TOBJECTFIELD; var T: BOOLEAN);
@ -586,11 +586,29 @@ begin Self.TRANSLITERATE := T; end;
procedure TBLOBFIELDTRANSLITERATE_R(Self: TBLOBFIELD; var T: BOOLEAN);
begin T := Self.TRANSLITERATE; end;
procedure TBLOBFIELDVALUE_W(Self: TBLOBFIELD; const T: STRING);
begin Self.VALUE := T; end;
procedure TBLOBFIELDVALUE_W(Self: TBLOBFIELD; const T: tbtstring);
{$IFDEF DELPHI2008UP}
var
b: TBytes;
begin
setLEngth(b, Length(T));
Move(T[1], b[0], Length(T));
self.Value := b;
{$ELSE}
begin
Self.VALUE := T;
{$ENDIF}
end;
procedure TBLOBFIELDVALUE_R(Self: TBLOBFIELD; var T: STRING);
begin T := Self.VALUE; end;
procedure TBLOBFIELDVALUE_R(Self: TBLOBFIELD; var T: tbtstring);
begin
{$IFDEF DELPHI2008UP}
SetLength(t, Length(SElf.Value));
Move(Self.Value[0], t[1], LEngth(T));
{$ELSE}
T := Self.VALUE;
{$ENDIF}
end;
procedure TBLOBFIELDMODIFIED_W(Self: TBLOBFIELD; const T: BOOLEAN);
begin Self.MODIFIED := T; end;
@ -609,16 +627,16 @@ begin Self.PRECISION := T; end;
procedure TFMTBCDFIELDPRECISION_R(Self: TFMTBCDFIELD; var T: INTEGER);
begin T := Self.PRECISION; end;
procedure TFMTBCDFIELDMINVALUE_W(Self: TFMTBCDFIELD; const T: STRING);
procedure TFMTBCDFIELDMINVALUE_W(Self: TFMTBCDFIELD; const T: tbtstring);
begin Self.MINVALUE := T; end;
procedure TFMTBCDFIELDMINVALUE_R(Self: TFMTBCDFIELD; var T: STRING);
procedure TFMTBCDFIELDMINVALUE_R(Self: TFMTBCDFIELD; var T: tbtstring);
begin T := Self.MINVALUE; end;
procedure TFMTBCDFIELDMAXVALUE_W(Self: TFMTBCDFIELD; const T: STRING);
procedure TFMTBCDFIELDMAXVALUE_W(Self: TFMTBCDFIELD; const T: tbtstring);
begin Self.MAXVALUE := T; end;
procedure TFMTBCDFIELDMAXVALUE_R(Self: TFMTBCDFIELD; var T: STRING);
procedure TFMTBCDFIELDMAXVALUE_R(Self: TFMTBCDFIELD; var T: tbtstring);
begin T := Self.MAXVALUE; end;
procedure TFMTBCDFIELDCURRENCY_W(Self: TFMTBCDFIELD; const T: BOOLEAN);
@ -666,10 +684,10 @@ begin T := Self.VALUE; end;
{$ENDIF}
procedure TDATETIMEFIELDDISPLAYFORMAT_W(Self: TDATETIMEFIELD; const T: STRING);
procedure TDATETIMEFIELDDISPLAYFORMAT_W(Self: TDATETIMEFIELD; const T: tbtstring);
begin Self.DISPLAYFORMAT := T; end;
procedure TDATETIMEFIELDDISPLAYFORMAT_R(Self: TDATETIMEFIELD; var T: STRING);
procedure TDATETIMEFIELDDISPLAYFORMAT_R(Self: TDATETIMEFIELD; var T: tbtstring);
begin T := Self.DISPLAYFORMAT; end;
procedure TDATETIMEFIELDVALUE_W(Self: TDATETIMEFIELD; const T: TDATETIME);
@ -678,10 +696,10 @@ begin Self.VALUE := T; end;
procedure TDATETIMEFIELDVALUE_R(Self: TDATETIMEFIELD; var T: TDATETIME);
begin T := Self.VALUE; end;
procedure TBOOLEANFIELDDISPLAYVALUES_W(Self: TBOOLEANFIELD; const T: STRING);
procedure TBOOLEANFIELDDISPLAYVALUES_W(Self: TBOOLEANFIELD; const T: tbtstring);
begin Self.DISPLAYVALUES := T; end;
procedure TBOOLEANFIELDDISPLAYVALUES_R(Self: TBOOLEANFIELD; var T: STRING);
procedure TBOOLEANFIELDDISPLAYVALUES_R(Self: TBOOLEANFIELD; var T: tbtstring);
begin T := Self.DISPLAYVALUES; end;
procedure TBOOLEANFIELDVALUE_W(Self: TBOOLEANFIELD; const T: BOOLEAN);
@ -764,16 +782,16 @@ begin Self.VALUE := T; end;
procedure TINTEGERFIELDVALUE_R(Self: TINTEGERFIELD; var T: LONGINT);
begin T := Self.VALUE; end;
procedure TNUMERICFIELDEDITFORMAT_W(Self: TNUMERICFIELD; const T: STRING);
procedure TNUMERICFIELDEDITFORMAT_W(Self: TNUMERICFIELD; const T: tbtstring);
begin Self.EDITFORMAT := T; end;
procedure TNUMERICFIELDEDITFORMAT_R(Self: TNUMERICFIELD; var T: STRING);
procedure TNUMERICFIELDEDITFORMAT_R(Self: TNUMERICFIELD; var T: tbtstring);
begin T := Self.EDITFORMAT; end;
procedure TNUMERICFIELDDISPLAYFORMAT_W(Self: TNUMERICFIELD; const T: STRING);
procedure TNUMERICFIELDDISPLAYFORMAT_W(Self: TNUMERICFIELD; const T: tbtstring);
begin Self.DISPLAYFORMAT := T; end;
procedure TNUMERICFIELDDISPLAYFORMAT_R(Self: TNUMERICFIELD; var T: STRING);
procedure TNUMERICFIELDDISPLAYFORMAT_R(Self: TNUMERICFIELD; var T: tbtstring);
begin T := Self.DISPLAYFORMAT; end;
{$IFNDEF FPC}
@ -797,10 +815,10 @@ begin T := Self.FIXEDCHAR; end;
{$ENDIF}
procedure TSTRINGFIELDVALUE_W(Self: TSTRINGFIELD; const T: STRING);
procedure TSTRINGFIELDVALUE_W(Self: TSTRINGFIELD; const T: tbtstring);
begin Self.VALUE := T; end;
procedure TSTRINGFIELDVALUE_R(Self: TSTRINGFIELD; var T: STRING);
procedure TSTRINGFIELDVALUE_R(Self: TSTRINGFIELD; var T: tbtstring);
begin T := Self.VALUE; end;
procedure TFIELDONVALIDATE_W(Self: TFIELD; const T: TFIELDNOTIFYEVENT);
@ -851,10 +869,10 @@ begin Self.PROVIDERFLAGS := T; end;
procedure TFIELDPROVIDERFLAGS_R(Self: TFIELD; var T: TPROVIDERFLAGS);
begin T := Self.PROVIDERFLAGS; end;
procedure TFIELDORIGIN_W(Self: TFIELD; const T: STRING);
procedure TFIELDORIGIN_W(Self: TFIELD; const T: tbtstring);
begin Self.ORIGIN := T; end;
procedure TFIELDORIGIN_R(Self: TFIELD; var T: STRING);
procedure TFIELDORIGIN_R(Self: TFIELD; var T: tbtstring);
begin T := Self.ORIGIN; end;
procedure TFIELDLOOKUPCACHE_W(Self: TFIELD; const T: BOOLEAN);
@ -863,22 +881,22 @@ begin Self.LOOKUPCACHE := T; end;
procedure TFIELDLOOKUPCACHE_R(Self: TFIELD; var T: BOOLEAN);
begin T := Self.LOOKUPCACHE; end;
procedure TFIELDKEYFIELDS_W(Self: TFIELD; const T: STRING);
procedure TFIELDKEYFIELDS_W(Self: TFIELD; const T: tbtstring);
begin Self.KEYFIELDS := T; end;
procedure TFIELDKEYFIELDS_R(Self: TFIELD; var T: STRING);
procedure TFIELDKEYFIELDS_R(Self: TFIELD; var T: tbtstring);
begin T := Self.KEYFIELDS; end;
procedure TFIELDLOOKUPRESULTFIELD_W(Self: TFIELD; const T: STRING);
procedure TFIELDLOOKUPRESULTFIELD_W(Self: TFIELD; const T: tbtstring);
begin Self.LOOKUPRESULTFIELD := T; end;
procedure TFIELDLOOKUPRESULTFIELD_R(Self: TFIELD; var T: STRING);
procedure TFIELDLOOKUPRESULTFIELD_R(Self: TFIELD; var T: tbtstring);
begin T := Self.LOOKUPRESULTFIELD; end;
procedure TFIELDLOOKUPKEYFIELDS_W(Self: TFIELD; const T: STRING);
procedure TFIELDLOOKUPKEYFIELDS_W(Self: TFIELD; const T: tbtstring);
begin Self.LOOKUPKEYFIELDS := T; end;
procedure TFIELDLOOKUPKEYFIELDS_R(Self: TFIELD; var T: STRING);
procedure TFIELDLOOKUPKEYFIELDS_R(Self: TFIELD; var T: tbtstring);
begin T := Self.LOOKUPKEYFIELDS; end;
procedure TFIELDLOOKUPDATASET_W(Self: TFIELD; const T: TDATASET);
@ -887,10 +905,10 @@ begin Self.LOOKUPDATASET := T; end;
procedure TFIELDLOOKUPDATASET_R(Self: TFIELD; var T: TDATASET);
begin T := Self.LOOKUPDATASET; end;
procedure TFIELDIMPORTEDCONSTRAINT_W(Self: TFIELD; const T: STRING);
procedure TFIELDIMPORTEDCONSTRAINT_W(Self: TFIELD; const T: tbtstring);
begin Self.IMPORTEDCONSTRAINT := T; end;
procedure TFIELDIMPORTEDCONSTRAINT_R(Self: TFIELD; var T: STRING);
procedure TFIELDIMPORTEDCONSTRAINT_R(Self: TFIELD; var T: tbtstring);
begin T := Self.IMPORTEDCONSTRAINT; end;
procedure TFIELDINDEX_W(Self: TFIELD; const T: INTEGER);
@ -902,10 +920,10 @@ begin T := Self.INDEX; end;
procedure TFIELDHASCONSTRAINTS_R(Self: TFIELD; var T: BOOLEAN);
begin T := Self.HASCONSTRAINTS; end;
procedure TFIELDFIELDNAME_W(Self: TFIELD; const T: STRING);
procedure TFIELDFIELDNAME_W(Self: TFIELD; const T: tbtstring);
begin Self.FIELDNAME := T; end;
procedure TFIELDFIELDNAME_R(Self: TFIELD; var T: STRING);
procedure TFIELDFIELDNAME_R(Self: TFIELD; var T: tbtstring);
begin T := Self.FIELDNAME; end;
procedure TFIELDFIELDKIND_W(Self: TFIELD; const T: TFIELDKIND);
@ -920,28 +938,28 @@ begin Self.DISPLAYWIDTH := T; end;
procedure TFIELDDISPLAYWIDTH_R(Self: TFIELD; var T: INTEGER);
begin T := Self.DISPLAYWIDTH; end;
procedure TFIELDDISPLAYLABEL_W(Self: TFIELD; const T: STRING);
procedure TFIELDDISPLAYLABEL_W(Self: TFIELD; const T: tbtstring);
begin Self.DISPLAYLABEL := T; end;
procedure TFIELDDISPLAYLABEL_R(Self: TFIELD; var T: STRING);
procedure TFIELDDISPLAYLABEL_R(Self: TFIELD; var T: tbtstring);
begin T := Self.DISPLAYLABEL; end;
procedure TFIELDDEFAULTEXPRESSION_W(Self: TFIELD; const T: STRING);
procedure TFIELDDEFAULTEXPRESSION_W(Self: TFIELD; const T: tbtstring);
begin Self.DEFAULTEXPRESSION := T; end;
procedure TFIELDDEFAULTEXPRESSION_R(Self: TFIELD; var T: STRING);
procedure TFIELDDEFAULTEXPRESSION_R(Self: TFIELD; var T: tbtstring);
begin T := Self.DEFAULTEXPRESSION; end;
procedure TFIELDCONSTRAINTERRORMESSAGE_W(Self: TFIELD; const T: STRING);
procedure TFIELDCONSTRAINTERRORMESSAGE_W(Self: TFIELD; const T: tbtstring);
begin Self.CONSTRAINTERRORMESSAGE := T; end;
procedure TFIELDCONSTRAINTERRORMESSAGE_R(Self: TFIELD; var T: STRING);
procedure TFIELDCONSTRAINTERRORMESSAGE_R(Self: TFIELD; var T: tbtstring);
begin T := Self.CONSTRAINTERRORMESSAGE; end;
procedure TFIELDCUSTOMCONSTRAINT_W(Self: TFIELD; const T: STRING);
procedure TFIELDCUSTOMCONSTRAINT_W(Self: TFIELD; const T: tbtstring);
begin Self.CUSTOMCONSTRAINT := T; end;
procedure TFIELDCUSTOMCONSTRAINT_R(Self: TFIELD; var T: STRING);
procedure TFIELDCUSTOMCONSTRAINT_R(Self: TFIELD; var T: tbtstring);
begin T := Self.CUSTOMCONSTRAINT; end;
{$IFNDEF FPC}
@ -980,10 +998,10 @@ begin Self.VALUE := T; end;
procedure TFIELDVALUE_R(Self: TFIELD; var T: VARIANT);
begin T := Self.VALUE; end;
procedure TFIELDTEXT_W(Self: TFIELD; const T: STRING);
procedure TFIELDTEXT_W(Self: TFIELD; const T: tbtstring);
begin Self.TEXT := T; end;
procedure TFIELDTEXT_R(Self: TFIELD; var T: STRING);
procedure TFIELDTEXT_R(Self: TFIELD; var T: tbtstring);
begin T := Self.TEXT; end;
procedure TFIELDSIZE_W(Self: TFIELD; const T: INTEGER);
@ -1014,17 +1032,17 @@ begin Self.LOOKUP := T; end;
procedure TFIELDLOOKUP_R(Self: TFIELD; var T: BOOLEAN);
begin T := Self.LOOKUP; end;
procedure TFIELDFULLNAME_R(Self: TFIELD; var T: STRING);
procedure TFIELDFULLNAME_R(Self: TFIELD; var T: tbtstring);
begin T := Self.FULLNAME; end;
procedure TFIELDEDITMASKPTR_R(Self: TFIELD; var T: STRING);
procedure TFIELDEDITMASKPTR_R(Self: TFIELD; var T: tbtstring);
begin T := Self.EDITMASKPTR; end;
procedure TFIELDEDITMASK_W(Self: TFIELD; const T: STRING);
procedure TFIELDEDITMASK_W(Self: TFIELD; const T: tbtstring);
begin Self.EDITMASK := T; end;
procedure TFIELDEDITMASK_R(Self: TFIELD; var T: STRING);
procedure TFIELDEDITMASK_R(Self: TFIELD; var T: tbtstring);
begin T := Self.EDITMASK; end;
{$ENDIF}
@ -1040,10 +1058,10 @@ begin T := Self.FIELDNO; end;
procedure TFIELDDISPLAYTEXT_R(Self: TFIELD; var T: STRING);
procedure TFIELDDISPLAYTEXT_R(Self: TFIELD; var T: tbtstring);
begin T := Self.DISPLAYTEXT; end;
procedure TFIELDDISPLAYNAME_R(Self: TFIELD; var T: STRING);
procedure TFIELDDISPLAYNAME_R(Self: TFIELD; var T: tbtstring);
begin T := Self.DISPLAYNAME; end;
procedure TFIELDDATATYPE_R(Self: TFIELD; var T: TFIELDTYPE);
@ -1070,10 +1088,10 @@ begin Self.CALCULATED := T; end;
procedure TFIELDCALCULATED_R(Self: TFIELD; var T: BOOLEAN);
begin T := Self.CALCULATED; end;
procedure TFIELDATTRIBUTESET_W(Self: TFIELD; const T: STRING);
procedure TFIELDATTRIBUTESET_W(Self: TFIELD; const T: tbtstring);
begin Self.ATTRIBUTESET := T; end;
procedure TFIELDATTRIBUTESET_R(Self: TFIELD; var T: STRING);
procedure TFIELDATTRIBUTESET_R(Self: TFIELD; var T: tbtstring);
begin T := Self.ATTRIBUTESET; end;
procedure TFIELDASVARIANT_W(Self: TFIELD; const T: VARIANT);
@ -1082,10 +1100,10 @@ begin Self.ASVARIANT := T; end;
procedure TFIELDASVARIANT_R(Self: TFIELD; var T: VARIANT);
begin T := Self.ASVARIANT; end;
procedure TFIELDASSTRING_W(Self: TFIELD; const T: STRING);
procedure TFIELDASSTRING_W(Self: TFIELD; const T: tbtstring);
begin Self.ASSTRING := T; end;
procedure TFIELDASSTRING_R(Self: TFIELD; var T: STRING);
procedure TFIELDASSTRING_R(Self: TFIELD; var T: tbtstring);
begin T := Self.ASSTRING; end;
procedure TFIELDASINTEGER_W(Self: TFIELD; const T: LONGINT);
@ -1164,10 +1182,10 @@ begin Self.ITEMS[t1] := T; end;
procedure TINDEXDEFSITEMS_R(Self: TINDEXDEFS; var T: TINDEXDEF; const t1: INTEGER);
begin T := Self.ITEMS[t1]; end;
procedure TINDEXDEFSOURCE_W(Self: TINDEXDEF; const T: STRING);
procedure TINDEXDEFSOURCE_W(Self: TINDEXDEF; const T: tbtstring);
begin Self.SOURCE := T; end;
procedure TINDEXDEFSOURCE_R(Self: TINDEXDEF; var T: STRING);
procedure TINDEXDEFSOURCE_R(Self: TINDEXDEF; var T: tbtstring);
begin T := Self.SOURCE; end;
procedure TINDEXDEFOPTIONS_W(Self: TINDEXDEF; const T: TINDEXOPTIONS);
@ -1176,33 +1194,33 @@ begin Self.OPTIONS := T; end;
procedure TINDEXDEFOPTIONS_R(Self: TINDEXDEF; var T: TINDEXOPTIONS);
begin T := Self.OPTIONS; end;
procedure TINDEXDEFFIELDS_W(Self: TINDEXDEF; const T: STRING);
procedure TINDEXDEFFIELDS_W(Self: TINDEXDEF; const T: tbtstring);
begin Self.FIELDS := T; end;
procedure TINDEXDEFFIELDS_R(Self: TINDEXDEF; var T: STRING);
procedure TINDEXDEFFIELDS_R(Self: TINDEXDEF; var T: tbtstring);
begin T := Self.FIELDS; end;
procedure TINDEXDEFEXPRESSION_W(Self: TINDEXDEF; const T: STRING);
procedure TINDEXDEFEXPRESSION_W(Self: TINDEXDEF; const T: tbtstring);
begin {$IFNDEF FPC}Self.EXPRESSION := T; {$ENDIF}end;
procedure TINDEXDEFEXPRESSION_R(Self: TINDEXDEF; var T: STRING);
procedure TINDEXDEFEXPRESSION_R(Self: TINDEXDEF; var T: tbtstring);
begin T := Self.EXPRESSION; end;
{$IFNDEF FPC}
procedure TINDEXDEFDESCFIELDS_W(Self: TINDEXDEF; const T: STRING);
procedure TINDEXDEFDESCFIELDS_W(Self: TINDEXDEF; const T: tbtstring);
begin Self.DESCFIELDS := T; end;
procedure TINDEXDEFDESCFIELDS_R(Self: TINDEXDEF; var T: STRING);
procedure TINDEXDEFDESCFIELDS_R(Self: TINDEXDEF; var T: tbtstring);
begin T := Self.DESCFIELDS; end;
procedure TINDEXDEFCASEINSFIELDS_W(Self: TINDEXDEF; const T: STRING);
procedure TINDEXDEFCASEINSFIELDS_W(Self: TINDEXDEF; const T: tbtstring);
begin Self.CASEINSFIELDS := T; end;
procedure TINDEXDEFCASEINSFIELDS_R(Self: TINDEXDEF; var T: STRING);
procedure TINDEXDEFCASEINSFIELDS_R(Self: TINDEXDEF; var T: tbtstring);
begin T := Self.CASEINSFIELDS; end;
procedure TINDEXDEFFIELDEXPRESSION_R(Self: TINDEXDEF; var T: STRING);
procedure TINDEXDEFFIELDEXPRESSION_R(Self: TINDEXDEF; var T: tbtstring);
begin T := Self.FIELDEXPRESSION; end;
procedure TFIELDDEFSPARENTDEF_R(Self: TFIELDDEFS; var T: TFIELDDEF);
@ -1283,10 +1301,10 @@ begin T := Self.UPDATED; end;
procedure TDEFCOLLECTIONDATASET_R(Self: TDEFCOLLECTION; var T: TDATASET);
begin T := Self.DATASET; end;
procedure TNAMEDITEMNAME_W(Self: TNAMEDITEM; const T: STRING);
procedure TNAMEDITEMNAME_W(Self: TNAMEDITEM; const T: tbtstring);
begin Self.NAME := T; end;
procedure TNAMEDITEMNAME_R(Self: TNAMEDITEM; var T: STRING);
procedure TNAMEDITEMNAME_R(Self: TNAMEDITEM; var T: tbtstring);
begin T := Self.NAME; end;

586
Source/uPSRuntime.pas
View File

File diff suppressed because it is too large Load Diff

115
Source/uPSUtils.pas
View File

@ -4,6 +4,7 @@ unit uPSUtils;
interface
uses
Classes, SysUtils;
const
PSMainProcName = '!MAIN';
@ -22,6 +23,7 @@ const
PSAddrNegativeStackStart = 1073741824;
type
TbtString = {$IFDEF DELPHI2008UP}RawByteString{$ELSE}String{$ENDIF};
TPSBaseType = Byte;
@ -95,7 +97,7 @@ const
btExtClass = 131;
function MakeHash(const s: string): Longint;
function MakeHash(const s: TbtString): Longint;
const
{ Script internal command: Assign command<br>
@ -297,13 +299,12 @@ type
tbtCurrency = Currency;
TbtString = string;
{$IFNDEF PS_NOINT64}
tbts64 = int64;
{$ENDIF}
tbtchar = char;
tbtchar = {$IFDEF DELPHI4UP}AnsiChar{$ELSE}CHAR{$ENDIF};
{$IFNDEF PS_NOWIDESTRING}
tbtwidestring = widestring;
@ -373,16 +374,16 @@ type
TPSStringList = class(TObject)
private
List: TPSList;
function GetItem(Nr: LongInt): string;
procedure SetItem(Nr: LongInt; const s: string);
function GetItem(Nr: LongInt): TbtString;
procedure SetItem(Nr: LongInt; const s: TbtString);
public
function Count: LongInt;
property Items[Nr: Longint]: string read GetItem write SetItem; default;
property Items[Nr: Longint]: TbtString read GetItem write SetItem; default;
procedure Add(const P: string);
procedure Add(const P: TbtString);
procedure Delete(NR: LongInt);
@ -511,12 +512,12 @@ type
TPSPascalParser = class(TObject)
protected
FData: string;
FText: PChar;
FData: TbtString;
FText: {$IFDEF DELPHI4UP}PAnsiChar{$ELSE}PChar{$ENDIF};
FLastEnterPos, FRow, FRealPosition, FTokenLength: Cardinal;
FTokenId: TPSPasToken;
FToken: string;
FOriginalToken: string;
FToken: TbtString;
FOriginalToken: TbtString;
FParserError: TPSParserErrorEvent;
FEnableComments: Boolean;
FEnableWhitespaces: Boolean;
@ -530,9 +531,9 @@ type
procedure Next; virtual;
property GetToken: string read FToken;
property GetToken: TbtString read FToken;
property OriginalToken: string read FOriginalToken;
property OriginalToken: TbtString read FOriginalToken;
property CurrTokenPos: Cardinal read FRealPosition;
@ -542,28 +543,28 @@ type
property Col: Cardinal read GetCol;
procedure SetText(const Data: string); virtual;
procedure SetText(const Data: TbtString); virtual;
property OnParserError: TPSParserErrorEvent read FParserError write FParserError;
end;
function FloatToStr(E: Extended): string;
function FloatToStr(E: Extended): TbtString;
function FastLowerCase(const s: String): string;
function FastLowerCase(const s: TbtString): TbtString;
function Fw(const S: string): string;
function Fw(const S: TbtString): TbtString;
function IntToStr(I: LongInt): string;
function IntToStr(I: LongInt): TbtString;
function StrToIntDef(const S: string; Def: LongInt): LongInt;
function StrToIntDef(const S: TbtString; Def: LongInt): LongInt;
function StrToInt(const S: string): LongInt;
function StrToFloat(const s: string): Extended;
function StrToInt(const S: TbtString): LongInt;
function StrToFloat(const s: TbtString): Extended;
function FastUpperCase(const s: String): string;
function FastUpperCase(const s: TbtString): TbtString;
function GRFW(var s: string): string;
function GRLW(var s: string): string;
function GRFW(var s: TbtString): TbtString;
function GRLW(var s: TbtString): TbtString;
const
@ -583,7 +584,7 @@ const
{$ENDIF }
RPS_InvalidFloat = 'Invalid float';
function MakeHash(const s: string): Longint;
function MakeHash(const s: TbtString): Longint;
{small hash maker}
var
I: Integer;
@ -593,7 +594,7 @@ begin
Result := ((Result shl 7) or (Result shr 25)) + Ord(s[I]);
end;
function GRFW(var s: string): string;
function GRFW(var s: TbtString): TbtString;
var
l: Longint;
begin
@ -612,7 +613,7 @@ begin
s := '';
end;
function GRLW(var s: string): string;
function GRLW(var s: TbtString): TbtString;
var
l: Longint;
begin
@ -631,38 +632,38 @@ begin
s := '';
end;
function StrToFloat(const s: string): Extended;
function StrToFloat(const s: TbtString): Extended;
var
i: longint;
begin
Val(s, Result, i);
Val(string(s), Result, i);
if i <> 0 then raise Exception.Create(RPS_InvalidFloat);
end;
//-------------------------------------------------------------------
function IntToStr(I: LongInt): string;
function IntToStr(I: LongInt): TbtString;
var
s: string;
s: tbtstring;
begin
Str(i, s);
IntToStr := s;
end;
//-------------------------------------------------------------------
function FloatToStr(E: Extended): string;
function FloatToStr(E: Extended): TbtString;
var
s: string;
s: tbtstring;
begin
Str(e:0:12, s);
result := s;
end;
function StrToInt(const S: string): LongInt;
function StrToInt(const S: TbtString): LongInt;
var
e: Integer;
Res: LongInt;
begin
Val(S, Res, e);
Val(string(S), Res, e);
if e <> 0 then
StrToInt := -1
else
@ -670,12 +671,12 @@ begin
end;
//-------------------------------------------------------------------
function StrToIntDef(const S: string; Def: LongInt): LongInt;
function StrToIntDef(const S: TbtString; Def: LongInt): LongInt;
var
e: Integer;
Res: LongInt;
begin
Val(S, Res, e);
Val(string(S), Res, e);
if e <> 0 then
StrToIntDef := Def
else
@ -853,11 +854,11 @@ function TPSStringList.Count: LongInt;
begin
count := List.count;
end;
type pStr = ^string;
type pStr = ^TbtString;
//-------------------------------------------------------------------
function TPSStringList.GetItem(Nr: LongInt): string;
function TPSStringList.GetItem(Nr: LongInt): TbtString;
var
S: PStr;
begin
@ -871,7 +872,7 @@ end;
//-------------------------------------------------------------------
procedure TPSStringList.SetItem(Nr: LongInt; const s: string);
procedure TPSStringList.SetItem(Nr: LongInt; const s: TbtString);
var
p: PStr;
begin
@ -883,7 +884,7 @@ begin
end;
//-------------------------------------------------------------------
procedure TPSStringList.Add(const P: string);
procedure TPSStringList.Add(const P: TbtString);
var
w: PStr;
begin
@ -927,21 +928,21 @@ end;
//-------------------------------------------------------------------
function Fw(const S: string): string; // First word
function Fw(const S: TbtString): TbtString; // First word
var
x: integer;
begin
x := pos(' ', s);
x := pos(tbtstring(' '), s);
if x > 0
then Fw := Copy(S, 1, x - 1)
else Fw := S;
end;
//-------------------------------------------------------------------
function FastUpperCase(const s: String): string;
function FastUpperCase(const s: TbtString): TbtString;
{Fast uppercase}
var
I: Integer;
C: Char;
C: tbtChar;
begin
Result := S;
I := Length(Result);
@ -949,15 +950,15 @@ begin
begin
C := Result[I];
if c in [#97..#122] then
Dec(Byte(Result[I]), 32);
Result[I] := tbtchar(Ord(Result[I]) -32);
Dec(I);
end;
end;
function FastLowerCase(const s: String): string;
function FastLowerCase(const s: TbtString): TbtString;
{Fast lowercase}
var
I: Integer;
C: Char;
C: tbtChar;
begin
Result := S;
I := Length(Result);
@ -965,7 +966,7 @@ begin
begin
C := Result[I];
if C in [#65..#90] then
Inc(Byte(Result[I]), 32);
Result[I] := tbtchar(Ord(Result[I]) + 32);
Dec(I);
end;
end;
@ -973,7 +974,7 @@ end;
type
TRTab = record
name: string;
name: TbtString;
c: TPSPasToken;
end;
@ -1056,11 +1057,11 @@ end;
procedure TPSPascalParser.Next;
var
Err: TPSParserErrorKind;
FLastUpToken: string;
FLastUpToken: TbtString;
function CheckReserved(Const S: ShortString; var CurrTokenId: TPSPasToken): Boolean;
var
L, H, I: LongInt;
J: Char;
J: tbtChar;
SName: ShortString;
begin
L := 0;
@ -1092,9 +1093,9 @@ var
end;
//-------------------------------------------------------------------
function _GetToken(CurrTokenPos, CurrTokenLen: Cardinal): string;
function _GetToken(CurrTokenPos, CurrTokenLen: Cardinal): TbtString;
var
s: string;
s: tbtString;
begin
SetLength(s, CurrTokenLen);
Move(FText[CurrTokenPos], S[1], CurrtokenLen);
@ -1106,7 +1107,7 @@ var
var
ct, ci: Cardinal;
hs: Boolean;
p: PChar;
p: {$IFDEF DELPHI4UP}PAnsiChar{$ELSE}PChar{$ENDIF};
begin
ParseToken := iNoError;
ct := CurrTokenPos;
@ -1125,7 +1126,7 @@ var
CurrTokenLen := ci - ct;
FLastUpToken := _GetToken(CurrTokenPos, CurrtokenLen);
p := pchar(FLastUpToken);
p := {$IFDEF DELPHI4UP}PAnsiChar{$ELSE}pchar{$ENDIF}(FLastUpToken);
while p^<>#0 do
begin
if p^ in [#97..#122] then
@ -1511,7 +1512,7 @@ begin
until False;
end;
procedure TPSPascalParser.SetText(const Data: string);
procedure TPSPascalParser.SetText(const Data: TbtString);
begin
FData := Data;
FText := Pointer(FData);

12
Source/x86.inc
View File

@ -271,7 +271,7 @@ var
var
varPtr: Pointer;
UseReg: Boolean;
tempstr: string;
tempstr: tbtstring;
p: Pointer;
begin
Result := False;
@ -419,7 +419,7 @@ var
btChar,
btU8,
btS8: begin
TempStr := char(fVar^.dta^) + #0#0#0;
TempStr := tbtchar(fVar^.dta^) + tbtstring(#0#0#0);
end;
{$IFNDEF PS_NOWIDESTRING}btWideChar, {$ENDIF}
btu16, btS16: begin
@ -549,7 +549,7 @@ begin
{$ENDIF}
btu32,bts32: tbtu32(res.dta^) := RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil);
btPChar: pchar(res.dta^) := Pchar(RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil));
btPChar: pansichar(res.dta^) := Pansichar(RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil));
{$IFNDEF PS_NOINT64}bts64:
begin
EAX := RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, @EDX);
@ -596,7 +596,7 @@ begin
btChar, btU8, btS8: tbtu8(res^.Dta^) := RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 1, nil);
{$IFNDEF PS_NOWIDESTRING}btWideChar, {$ENDIF}btu16, bts16: tbtu16(res^.Dta^) := RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 2, nil);
btClass, btu32, bts32: tbtu32(res^.Dta^):= RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil);
btPChar: TBTSTRING(res^.dta^) := Pchar(RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil));
btPChar: TBTSTRING(res^.dta^) := Pansichar(RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil));
{$IFNDEF PS_NOINT64}bts64:
begin
EAX := RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, @EDX);
@ -645,7 +645,7 @@ begin
btCHar, btU8, btS8: tbtu8(res^.dta^) := RealCall_Cdecl(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 1, nil);
{$IFNDEF PS_NOWIDESTRING}btWideChar, {$ENDIF}btu16, bts16: tbtu16(res^.dta^) := RealCall_Cdecl(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 2, nil);
btClass, btu32, bts32: tbtu32(res^.dta^) := RealCall_Cdecl(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil);
btPChar: TBTSTRING(res^.dta^) := Pchar(RealCall_Cdecl(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil));
btPChar: TBTSTRING(res^.dta^) := Pansichar(RealCall_Cdecl(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil));
{$IFNDEF PS_NOINT64}bts64:
begin
EAX := RealCall_CDecl(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, @EDX);
@ -680,7 +680,7 @@ begin
btChar, btU8, btS8: tbtu8(res^.dta^) := RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 1, nil);
{$IFNDEF PS_NOWIDESTRING}btWideChar, {$ENDIF}btu16, bts16: tbtu16(res^.dta^) := RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 2, nil);
btclass, btu32, bts32: tbtu32(res^.dta^) := RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil);
btPChar: TBTSTRING(res^.dta^) := Pchar(RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil));
btPChar: TBTSTRING(res^.dta^) := Pansichar(RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil));
{$IFNDEF PS_NOINT64}bts64:
begin
EAX := RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, @EDX);