ViewVC Help

View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing

root/public/ibx/trunk/fbintf/client/FBAttachment.pas

Comparing ibx/trunk/fbintf/client/FBAttachment.pas (file contents):
Revision 45 by tony, Tue Dec 6 10:33:46 2016 UTC vs.
Revision 209 by tony, Wed Mar 14 12:48:51 2018 UTC

#	Line 25 | Line 25
25		*
26		*)
27		unit FBAttachment;
28	+	{$IFDEF MSWINDOWS}
29	+	{$DEFINE WINDOWS}
30	+	{$ENDIF}
31
32		{$IFDEF FPC}
33	<	{$mode objfpc}{$H+}
33	>	{$mode delphi}
34		{$interfaces COM}
35	+	{$define HASREQEX}
36		{$ENDIF}
37
38		interface
39
40		uses
41	<	Classes, SysUtils, IB,  FBParamBlock, FBActivityMonitor;
41	>	Classes, SysUtils, {$IFDEF WINDOWS} windows, {$ENDIF} IB,  FBParamBlock, FBActivityMonitor;
42
43		type
44	+	TCharsetMap = record
45	+	CharsetID: integer;
46	+	CharSetName: AnsiString;
47	+	CharSetWidth: integer;
48	+	CodePage: TSystemCodePage;
49	+	AllowReverseLookup: boolean; {used to ensure that lookup of CP_UTF* does not return UNICODE_FSS}
50	+	end;
51
52		{ TFBAttachment }
53
#	Line 44 | Line 55 | type
55		private
56		FDPB: IDPB;
57		FFirebirdAPI: IFirebirdAPI;
58	+	FODSMajorVersion: integer;
59	+	FODSMinorVersion: integer;
60	+	FUserCharSetMap: array of TCharSetMap;
61	+	FSecDatabase: AnsiString;
62		protected
63	<	FDatabaseName: string;
63	>	FDatabaseName: AnsiString;
64		FRaiseExceptionOnConnectError: boolean;
65		FSQLDialect: integer;
66		FHasDefaultCharSet: boolean;
67		FCharSetID: integer;
68		FCodePage: TSystemCodePage;
69	<	constructor Create(DatabaseName: string; DPB: IDPB;
69	>	FRemoteProtocol: AnsiString;
70	>	FAuthMethod: AnsiString;
71	>	constructor Create(DatabaseName: AnsiString; DPB: IDPB;
72		RaiseExceptionOnConnectError: boolean);
73		procedure CheckHandle; virtual; abstract;
74	<	function GenerateCreateDatabaseSQL(DatabaseName: string; aDPB: IDPB): string;
74	>	function GenerateCreateDatabaseSQL(DatabaseName: AnsiString; aDPB: IDPB): AnsiString;
75	>	procedure GetODSAndConnectionInfo;
76	>	function GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation; virtual; abstract;
77	>	function IsConnected: boolean; virtual; abstract;
78		procedure EndAllTransactions;
79	+	procedure DPBFromCreateSQL(CreateSQL: AnsiString);
80		procedure SetParameters(SQLParams: ISQLParams; params: array of const);
81		public
82		destructor Destroy; override;
83		function getDPB: IDPB;
84		function AllocateBPB: IBPB;
85	+	function AllocateDIRB: IDIRB;
86		function StartTransaction(TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction; overload; virtual; abstract;
87		function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction; overload; virtual; abstract;
88		procedure Disconnect(Force: boolean=false); virtual; abstract;
89	<	procedure ExecImmediate(transaction: ITransaction; sql: string; aSQLDialect: integer); overload; virtual; abstract;
90	<	procedure ExecImmediate(TPB: array of byte; sql: string; aSQLDialect: integer); overload;
91	<	procedure ExecImmediate(transaction: ITransaction; sql: string); overload;
92	<	procedure ExecImmediate(TPB: array of byte; sql: string); overload;
93	<	function ExecuteSQL(TPB: array of byte; sql: string; SQLDialect: integer; params: array of const): IResults; overload;
94	<	function ExecuteSQL(transaction: ITransaction; sql: string; SQLDialect: integer; params: array of const): IResults; overload;
95	<	function ExecuteSQL(TPB: array of byte; sql: string; params: array of const): IResults; overload;
96	<	function ExecuteSQL(transaction: ITransaction; sql: string; params: array of const): IResults; overload;
97	<	function OpenCursor(transaction: ITransaction; sql: string; aSQLDialect: integer): IResultSet; overload;
98	<	function OpenCursor(transaction: ITransaction; sql: string; aSQLDialect: integer;
89	>	procedure ExecImmediate(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer); overload; virtual; abstract;
90	>	procedure ExecImmediate(TPB: array of byte; sql: AnsiString; aSQLDialect: integer); overload;
91	>	procedure ExecImmediate(transaction: ITransaction; sql: AnsiString); overload;
92	>	procedure ExecImmediate(TPB: array of byte; sql: AnsiString); overload;
93	>	function ExecuteSQL(TPB: array of byte; sql: AnsiString; SQLDialect: integer; params: array of const): IResults; overload;
94	>	function ExecuteSQL(transaction: ITransaction; sql: AnsiString; SQLDialect: integer; params: array of const): IResults; overload;
95	>	function ExecuteSQL(TPB: array of byte; sql: AnsiString; params: array of const): IResults; overload;
96	>	function ExecuteSQL(transaction: ITransaction; sql: AnsiString; params: array of const): IResults; overload;
97	>	function OpenCursor(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer): IResultSet; overload;
98	>	function OpenCursor(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
99		params: array of const): IResultSet; overload;
100	<	function OpenCursor(transaction: ITransaction; sql: string): IResultSet; overload;
101	<	function OpenCursor(transaction: ITransaction; sql: string;
100	>	function OpenCursor(transaction: ITransaction; sql: AnsiString): IResultSet; overload;
101	>	function OpenCursor(transaction: ITransaction; sql: AnsiString;
102		params: array of const): IResultSet; overload;
103	<	function OpenCursorAtStart(transaction: ITransaction; sql: string; aSQLDialect: integer): IResultSet; overload;
104	<	function OpenCursorAtStart(transaction: ITransaction; sql: string; aSQLDialect: integer;
103	>	function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer): IResultSet; overload;
104	>	function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
105		params: array of const): IResultSet; overload;
106	<	function OpenCursorAtStart(transaction: ITransaction; sql: string): IResultSet; overload;
107	<	function OpenCursorAtStart(transaction: ITransaction; sql: string;
106	>	function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString): IResultSet; overload;
107	>	function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString;
108		params: array of const): IResultSet; overload;
109	<	function OpenCursorAtStart(sql: string): IResultSet; overload;
110	<	function OpenCursorAtStart(sql: string;
109	>	function OpenCursorAtStart(sql: AnsiString): IResultSet; overload;
110	>	function OpenCursorAtStart(sql: AnsiString;
111		params: array of const): IResultSet; overload;
112	<	function Prepare(transaction: ITransaction; sql: string; aSQLDialect: integer): IStatement; overload; virtual; abstract;
113	<	function Prepare(transaction: ITransaction; sql: string): IStatement; overload;
114	<	function PrepareWithNamedParameters(transaction: ITransaction; sql: string;
112	>	function Prepare(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer): IStatement; overload; virtual; abstract;
113	>	function Prepare(transaction: ITransaction; sql: AnsiString): IStatement; overload;
114	>	function PrepareWithNamedParameters(transaction: ITransaction; sql: AnsiString;
115		aSQLDialect: integer; GenerateParamNames: boolean=false): IStatement; overload; virtual; abstract;
116	<	function PrepareWithNamedParameters(transaction: ITransaction; sql: string;
116	>	function PrepareWithNamedParameters(transaction: ITransaction; sql: AnsiString;
117		GenerateParamNames: boolean=false): IStatement; overload;
118		function GetEventHandler(Events: TStrings): IEvents; overload; virtual; abstract;
119	<	function GetEventHandler(Event: string): IEvents; overload;
119	>	function GetEventHandler(Event: AnsiString): IEvents; overload;
120
121		function GetSQLDialect: integer;
122	<	function OpenBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; virtual; abstract; overload;
122	>	function OpenBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload; virtual; abstract;
123		function OpenBlob(transaction: ITransaction; Field: ISQLData; BPB: IBPB=nil): IBlob; overload;
124		property SQLDialect: integer read FSQLDialect;
103	–	property HasDefaultCharSet: boolean read FHasDefaultCharSet;
104	–	property CharSetID: integer read FCharSetID;
105	–	property CodePage: TSystemCodePage read FCodePage;
125		property DPB: IDPB read FDPB;
126	+	public
127	+	function GetDBInformation(Requests: array of byte): IDBInformation; overload;
128	+	function GetDBInformation(Request: byte): IDBInformation; overload;
129	+	function GetDBInformation(Requests: IDIRB): IDBInformation; overload;
130	+	function GetConnectString: AnsiString;
131	+	function GetRemoteProtocol: AnsiString;
132	+	function GetAuthenticationMethod: AnsiString;
133	+	function GetSecurityDatabase: AnsiString;
134	+	function GetODSMajorVersion: integer;
135	+	function GetODSMinorVersion: integer;
136	+	{Character Sets}
137	+	function HasDefaultCharSet: boolean;
138	+	function GetDefaultCharSetID: integer;
139	+	function GetCharsetName(CharSetID: integer): AnsiString;
140	+	function CharSetID2CodePage(CharSetID: integer; var CodePage: TSystemCodePage): boolean;
141	+	function CodePage2CharSetID(CodePage: TSystemCodePage; var CharSetID: integer): boolean;
142	+	function CharSetName2CharSetID(CharSetName: AnsiString; var CharSetID: integer): boolean;
143	+	function CharSetWidth(CharSetID: integer; var Width: integer): boolean;
144	+	procedure RegisterCharSet(CharSetName: AnsiString; CodePage: TSystemCodePage;
145	+	AllowReverseLookup:boolean; out CharSetID: integer);
146	+	property CharSetID: integer read FCharSetID;
147	+	property CodePage: TSystemCodePage read FCodePage;
148		end;
149
150		implementation
151
152	<	uses FBMessages, FBTransaction;
152	>	uses FBMessages, IBUtils, FBTransaction {$IFDEF HASREQEX}, RegExpr{$ENDIF};
153	>
154	>	const
155	>	CharSetMap: array [0..69] of TCharsetMap = (
156	>	(CharsetID: 0; CharSetName: 'NONE'; CharSetWidth: 1; CodePage: CP_ACP; AllowReverseLookup: true),
157	>	(CharsetID: 1; CharSetName: 'OCTETS'; CharSetWidth: 1; CodePage: CP_NONE; AllowReverseLookup: true),
158	>	(CharsetID: 2; CharSetName: 'ASCII'; CharSetWidth: 1; CodePage: CP_ASCII; AllowReverseLookup: true),
159	>	(CharsetID: 3; CharSetName: 'UNICODE_FSS'; CharSetWidth: 3; CodePage: CP_UTF8; AllowReverseLookup: false),
160	>	(CharsetID: 4; CharSetName: 'UTF8'; CharSetWidth: 4; CodePage: CP_UTF8; AllowReverseLookup: true),
161	>	(CharsetID: 5; CharSetName: 'SJIS_0208'; CharSetWidth: 2; CodePage: 20932; AllowReverseLookup: true),
162	>	(CharsetID: 6; CharSetName: 'EUCJ_0208'; CharSetWidth: 2; CodePage: 20932; AllowReverseLookup: true),
163	>	(CharsetID: 7; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: true),
164	>	(CharsetID: 8; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: true),
165	>	(CharsetID: 9; CharSetName: 'DOS737'; CharSetWidth: 1; CodePage: 737; AllowReverseLookup: true),
166	>	(CharsetID: 10; CharSetName: 'DOS437'; CharSetWidth: 1; CodePage: 437; AllowReverseLookup: true),
167	>	(CharsetID: 11; CharSetName: 'DOS850'; CharSetWidth: 1; CodePage: 850; AllowReverseLookup: true),
168	>	(CharsetID: 12; CharSetName: 'DOS865'; CharSetWidth: 1; CodePage: 865; AllowReverseLookup: true),
169	>	(CharsetID: 13; CharSetName: 'DOS860'; CharSetWidth: 1; CodePage: 860; AllowReverseLookup: true),
170	>	(CharsetID: 14; CharSetName: 'DOS863'; CharSetWidth: 1; CodePage: 863; AllowReverseLookup: true),
171	>	(CharsetID: 15; CharSetName: 'DOS775'; CharSetWidth: 1; CodePage: 775; AllowReverseLookup: true),
172	>	(CharsetID: 16; CharSetName: 'DOS858'; CharSetWidth: 1; CodePage: 858; AllowReverseLookup: true),
173	>	(CharsetID: 17; CharSetName: 'DOS862'; CharSetWidth: 1; CodePage: 862; AllowReverseLookup: true),
174	>	(CharsetID: 18; CharSetName: 'DOS864'; CharSetWidth: 1; CodePage: 864; AllowReverseLookup: true),
175	>	(CharsetID: 19; CharSetName: 'NEXT'; CharSetWidth: 1; CodePage: CP_NONE; AllowReverseLookup: true),
176	>	(CharsetID: 20; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: true),
177	>	(CharsetID: 21; CharSetName: 'ISO8859_1'; CharSetWidth: 1; CodePage: 28591; AllowReverseLookup: true),
178	>	(CharsetID: 22; CharSetName: 'ISO8859_2'; CharSetWidth: 1; CodePage: 28592; AllowReverseLookup: true),
179	>	(CharsetID: 23; CharSetName: 'ISO8859_3'; CharSetWidth: 1; CodePage: 28593; AllowReverseLookup: true),
180	>	(CharsetID: 24; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: false),
181	>	(CharsetID: 25; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: false),
182	>	(CharsetID: 26; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: false),
183	>	(CharsetID: 27; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: false),
184	>	(CharsetID: 28; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: false),
185	>	(CharsetID: 29; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: false),
186	>	(CharsetID: 30; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: false),
187	>	(CharsetID: 31; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: false),
188	>	(CharsetID: 32; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: false),
189	>	(CharsetID: 33; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: false),
190	>	(CharsetID: 34; CharSetName: 'ISO8859_4'; CharSetWidth: 1; CodePage: 28594; AllowReverseLookup: true),
191	>	(CharsetID: 35; CharSetName: 'ISO8859_5'; CharSetWidth: 1; CodePage: 28595; AllowReverseLookup: true),
192	>	(CharsetID: 36; CharSetName: 'ISO8859_6'; CharSetWidth: 1; CodePage: 28596; AllowReverseLookup: true),
193	>	(CharsetID: 37; CharSetName: 'ISO8859_7'; CharSetWidth: 1; CodePage: 28597; AllowReverseLookup: true),
194	>	(CharsetID: 38; CharSetName: 'ISO8859_8'; CharSetWidth: 1; CodePage: 28598; AllowReverseLookup: true),
195	>	(CharsetID: 39; CharSetName: 'ISO8859_9'; CharSetWidth: 1; CodePage: 28599; AllowReverseLookup: true),
196	>	(CharsetID: 40; CharSetName: 'ISO8859_13'; CharSetWidth: 1; CodePage: 28603; AllowReverseLookup: true),
197	>	(CharsetID: 41; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: false),
198	>	(CharsetID: 42; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: false),
199	>	(CharsetID: 43; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: false),
200	>	(CharsetID: 44; CharSetName: 'KSC_5601'; CharSetWidth: 2; CodePage: 949; AllowReverseLookup: true),
201	>	(CharsetID: 45; CharSetName: 'DOS852'; CharSetWidth: 1; CodePage: 852; AllowReverseLookup: true),
202	>	(CharsetID: 46; CharSetName: 'DOS857'; CharSetWidth: 1; CodePage: 857; AllowReverseLookup: true),
203	>	(CharsetID: 47; CharSetName: 'DOS861'; CharSetWidth: 1; CodePage: 861; AllowReverseLookup: true),
204	>	(CharsetID: 48; CharSetName: 'DOS866'; CharSetWidth: 1; CodePage: 866; AllowReverseLookup: true),
205	>	(CharsetID: 49; CharSetName: 'DOS869'; CharSetWidth: 1; CodePage: 869; AllowReverseLookup: true),
206	>	(CharsetID: 50; CharSetName: 'CYRL'; CharSetWidth: 1; CodePage: 1251; AllowReverseLookup: true),
207	>	(CharsetID: 51; CharSetName: 'WIN1250'; CharSetWidth: 1; CodePage: 1250; AllowReverseLookup: true),
208	>	(CharsetID: 52; CharSetName: 'WIN1251'; CharSetWidth: 1; CodePage: 1251; AllowReverseLookup: true),
209	>	(CharsetID: 53; CharSetName: 'WIN1252'; CharSetWidth: 1; CodePage: 1252; AllowReverseLookup: true),
210	>	(CharsetID: 54; CharSetName: 'WIN1253'; CharSetWidth: 1; CodePage: 1253; AllowReverseLookup: true),
211	>	(CharsetID: 55; CharSetName: 'WIN1254'; CharSetWidth: 1; CodePage: 1254; AllowReverseLookup: true),
212	>	(CharsetID: 56; CharSetName: 'BIG_5'; CharSetWidth: 2; CodePage: 950; AllowReverseLookup: true),
213	>	(CharsetID: 57; CharSetName: 'GB_2312'; CharSetWidth: 2; CodePage: 936; AllowReverseLookup: true),
214	>	(CharsetID: 58; CharSetName: 'WIN1255'; CharSetWidth: 1; CodePage: 1255; AllowReverseLookup: true),
215	>	(CharsetID: 59; CharSetName: 'WIN1256'; CharSetWidth: 1; CodePage: 1256; AllowReverseLookup: true),
216	>	(CharsetID: 60; CharSetName: 'WIN1257'; CharSetWidth: 1; CodePage: 1257; AllowReverseLookup: true),
217	>	(CharsetID: 61; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: false),
218	>	(CharsetID: 62; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE; AllowReverseLookup: false),
219	>	(CharsetID: 63; CharSetName: 'KOI8R'; CharSetWidth: 1; CodePage: 20866; AllowReverseLookup: true),
220	>	(CharsetID: 64; CharSetName: 'KOI8U'; CharSetWidth: 1; CodePage: 21866; AllowReverseLookup: true),
221	>	(CharsetID: 65; CharSetName: 'WIN1258'; CharSetWidth: 1; CodePage: 1258; AllowReverseLookup: true),
222	>	(CharsetID: 66; CharSetName: 'TIS620'; CharSetWidth: 1; CodePage: 874; AllowReverseLookup: true),
223	>	(CharsetID: 67; CharSetName: 'GBK'; CharSetWidth: 2; CodePage: 936; AllowReverseLookup: true),
224	>	(CharsetID: 68; CharSetName: 'CP943C'; CharSetWidth: 2; CodePage: 943; AllowReverseLookup: true),
225	>	(CharsetID: 69; CharSetName: 'GB18030'; CharSetWidth: 4; CodePage: 54936; AllowReverseLookup: true)
226	>	);
227	>
228	>
229	>
230
231		{ TFBAttachment }
232
233	<	constructor TFBAttachment.Create(DatabaseName: string; DPB: IDPB;
233	>	procedure TFBAttachment.GetODSAndConnectionInfo;
234	>	var DBInfo: IDBInformation;
235	>	i: integer;
236	>	Stmt: IStatement;
237	>	ResultSet: IResultSet;
238	>	Param: IDPBItem;
239	>	begin
240	>	if not IsConnected then Exit;
241	>	DBInfo := GetDBInformation([isc_info_db_id,isc_info_ods_version,isc_info_ods_minor_version,
242	>	isc_info_db_SQL_Dialect]);
243	>	for i := 0 to DBInfo.GetCount - 1 do
244	>	with DBInfo[i] do
245	>	case getItemType of
246	>	isc_info_ods_minor_version:
247	>	FODSMinorVersion := getAsInteger;
248	>	isc_info_ods_version:
249	>	FODSMajorVersion := getAsInteger;
250	>	isc_info_db_SQL_Dialect:
251	>	FSQLDialect := getAsInteger;
252	>	end;
253	>
254	>	FCharSetID := 0;
255	>	FRemoteProtocol := '';
256	>	FAuthMethod := 'Legacy_Auth';
257	>	FSecDatabase := 'Default';
258	>	if FODSMajorVersion > 11 then
259	>	begin
260	>	Stmt := Prepare(StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit),
261	>	'Select MON$CHARACTER_SET_ID, MON$REMOTE_PROTOCOL, MON$AUTH_METHOD, MON$SEC_DATABASE From MON$ATTACHMENTS, MON$DATABASE '+
262	>	'Where MON$ATTACHMENT_ID = CURRENT_CONNECTION');
263	>	ResultSet := Stmt.OpenCursor;
264	>	if ResultSet.FetchNext then
265	>	begin
266	>	FCharSetID := ResultSet[0].AsInteger;
267	>	FRemoteProtocol := Trim(ResultSet[1].AsString);
268	>	FAuthMethod := Trim(ResultSet[2].AsString);
269	>	FSecDatabase := Trim(ResultSet[3].AsString);
270	>	end
271	>	end
272	>	else
273	>	if (FODSMajorVersion = 11) and (FODSMinorVersion >= 1) then
274	>	begin
275	>	Stmt := Prepare(StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit),
276	>	'Select MON$CHARACTER_SET_ID, MON$REMOTE_PROTOCOL From MON$ATTACHMENTS '+
277	>	'Where MON$ATTACHMENT_ID = CURRENT_CONNECTION');
278	>	ResultSet := Stmt.OpenCursor;
279	>	if ResultSet.FetchNext then
280	>	begin
281	>	FCharSetID := ResultSet[0].AsInteger;
282	>	FRemoteProtocol := Trim(ResultSet[1].AsString);
283	>	end
284	>	end
285	>	else
286	>	if DPB <> nil then
287	>	begin
288	>	Param :=  DPB.Find(isc_dpb_lc_ctype);
289	>	if (Param = nil) or not CharSetName2CharSetID(Param.AsString,FCharSetID) then
290	>	FCharSetID := 0;
291	>	case GetProtocol(FDatabaseName) of
292	>	TCP:       FRemoteProtocol := 'TCPv4';
293	>	Local:     FRemoteProtocol := '';
294	>	NamedPipe: FRemoteProtocol := 'Netbui';
295	>	SPX:       FRemoteProtocol := 'SPX'
296	>	end;
297	>	end;
298	>	FHasDefaultCharSet := CharSetID2CodePage(FCharSetID,FCodePage) and (FCharSetID > 1);
299	>	end;
300	>
301	>	constructor TFBAttachment.Create(DatabaseName: AnsiString; DPB: IDPB;
302		RaiseExceptionOnConnectError: boolean);
303		begin
304		inherited Create;
#	Line 120 | Line 306 | begin
306		FSQLDialect := 3;
307		FDatabaseName := DatabaseName;
308		FDPB := DPB;
309	+	SetLength(FUserCharSetMap,0);
310		FRaiseExceptionOnConnectError := RaiseExceptionOnConnectError;
311	+	FODSMajorVersion := 0;
312	+	FODSMinorVersion := 0;
313		end;
314
315	<	function TFBAttachment.GenerateCreateDatabaseSQL(DatabaseName: string;  aDPB: IDPB): string;
316	<	var CreateParams: string;
315	>	function TFBAttachment.GenerateCreateDatabaseSQL(DatabaseName: AnsiString;  aDPB: IDPB): AnsiString;
316	>	var CreateParams: AnsiString;
317		DPBItem: IDPBItem;
318		begin
319		CreateParams := '';
#	Line 133 | Line 322 | begin
322		begin
323		DPBItem :=  aDPB.Find(isc_dpb_user_name);
324		if DPBItem <> nil then
325	<	CreateParams += ' USER ''' + DPBItem.AsString + '''';
325	>	CreateParams := CreateParams + ' USER ''' + DPBItem.AsString + '''';
326
327		DPBItem :=  aDPB.Find(isc_dpb_password);
328		if DPBItem <> nil then
329	<	CreateParams += ' Password ''' + DPBItem.AsString + '''';
329	>	CreateParams := CreateParams + ' Password ''' + DPBItem.AsString + '''';
330
331		DPBItem :=  aDPB.Find(isc_dpb_page_size);
332		if DPBItem <> nil then
333	<	CreateParams += ' PAGE_SIZE ' + DPBItem.AsString;
333	>	CreateParams := CreateParams + ' PAGE_SIZE ' + DPBItem.AsString;
334
335		DPBItem :=  aDPB.Find(isc_dpb_lc_ctype);
336		if DPBItem <> nil then
337	<	CreateParams += ' DEFAULT CHARACTER SET ' + DPBItem.AsString;
337	>	CreateParams := CreateParams + ' DEFAULT CHARACTER SET ' + DPBItem.AsString;
338
339		DPBItem :=  aDPB.Find(isc_dpb_sql_dialect);
340		if DPBItem <> nil then
#	Line 167 | Line 356 | begin
356		end;
357		end;
358
359	+	{$IFDEF HASREQEX}
360	+	procedure TFBAttachment.DPBFromCreateSQL(CreateSQL: AnsiString);
361	+	var RegexObj: TRegExpr;
362	+	begin
363	+	FDPB := FFirebirdAPI.AllocateDPB;
364	+	RegexObj := TRegExpr.Create;
365	+	try
366	+	{extact database file spec}
367	+	RegexObj.ModifierG := false; {turn off greedy matches}
368	+	RegexObj.ModifierI := true; {case insensitive match}
369	+	RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +''.*'' +USER +''(.+)'' PASSWORD +''(.+)''';
370	+	if RegexObj.Exec(CreateSQL) then
371	+	begin
372	+	DPB.Add(isc_dpb_user_name).AsString := system.copy(CreateSQL,RegexObj.MatchPos[2],RegexObj.MatchLen[2]);
373	+	DPB.Add(isc_dpb_password).AsString := system.copy(CreateSQL,RegexObj.MatchPos[3],RegexObj.MatchLen[3]);
374	+	end
375	+	else
376	+	begin
377	+	RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +(''.*'') +USER +''(.+)''';
378	+	if RegexObj.Exec(CreateSQL) then
379	+	DPB.Add(isc_dpb_user_name).AsString := system.copy(CreateSQL,RegexObj.MatchPos[2],RegexObj.MatchLen[2]);
380	+	end;
381	+	finally
382	+	RegexObj.Free;
383	+	end;
384	+	if FCharSetID > 0 then
385	+	DPB.Add(isc_dpb_lc_ctype).AsString := GetCharSetName(FCharSetID);
386	+	DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(FSQLDialect);
387	+	end;
388	+	{$ELSE}
389	+	procedure TFBAttachment.DPBFromCreateSQL(CreateSQL: AnsiString);
390	+	begin
391	+	FDPB := FFirebirdAPI.AllocateDPB;
392	+	if FCharSetID > 0 then
393	+	DPB.Add(isc_dpb_lc_ctype).AsString := GetCharSetName(FCharSetID);
394	+	DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(FSQLDialect);
395	+	end;
396	+	{$ENDIF}
397	+
398		procedure TFBAttachment.SetParameters(SQLParams: ISQLParams;
399		params: array of const);
400		var i: integer;
#	Line 179 | Line 407 | begin
407		case params[i].vtype of
408		vtinteger    :
409		SQLParams[i].AsInteger := params[i].vinteger;
410	+	vtInt64:
411	+	SQLParams[i].AsInt64 := params[i].VInt64^;
412	+	{$IF declared (vtQWord)}
413	+	vtQWord:
414	+	SQLParams[i].AsInt64 := params[i].VQWord^;
415	+	{$IFEND}
416		vtboolean    :
417		SQLParams[i].AsBoolean :=  params[i].vboolean;
418		vtchar       :
#	Line 188 | Line 422 | begin
422		vtCurrency:
423		SQLParams[i].AsDouble := params[i].VCurrency^;
424		vtString     :
425	<	SQLParams[i].AsString := params[i].VString^;
425	>	SQLParams[i].AsString := strpas(PChar(params[i].VString));
426		vtPChar      :
427		SQLParams[i].AsString := strpas(params[i].VPChar);
428		vtAnsiString :
429	<	SQLParams[i].AsString := AnsiString(params[i].VAnsiString^);
429	>	SQLParams[i].AsString := strpas(PAnsiChar(params[i].VAnsiString));
430		vtVariant:
431		SQLParams[i].AsVariant := params[i].VVariant^;
432	+	vtWideChar:
433	+	SQLParams[i].AsString := UTF8Encode(WideCharLenToString(@params[i].VWideChar,1));
434	+	vtPWideChar:
435	+	SQLParams[i].AsString := UTF8Encode(strpas(PWideChar(params[i].VPWideChar)));
436	+	vtWideString:
437	+	SQLParams[i].AsString := UTF8Encode(strpas(PWideChar(params[i].VWideString)));
438	+	vtUnicodeString:
439	+	SQLParams[i].AsString := UTF8Encode(strpas(PWideChar(params[i].VUnicodeString)));
440		else
441		IBError(ibxeInvalidVariantType,[nil]);
442		end;
#	Line 217 | Line 459 | begin
459		Result := TBPB.Create;
460		end;
461
462	<	procedure TFBAttachment.ExecImmediate(TPB: array of byte; sql: string;
462	>	function TFBAttachment.AllocateDIRB: IDIRB;
463	>	begin
464	>	Result := TDIRB.Create;
465	>	end;
466	>
467	>	procedure TFBAttachment.ExecImmediate(TPB: array of byte; sql: AnsiString;
468		aSQLDialect: integer);
469		begin
470		ExecImmediate(StartTransaction(TPB,taCommit),sql,aSQLDialect);
471		end;
472
473	<	procedure TFBAttachment.ExecImmediate(transaction: ITransaction; sql: string);
473	>	procedure TFBAttachment.ExecImmediate(transaction: ITransaction; sql: AnsiString);
474		begin
475		ExecImmediate(transaction,sql,FSQLDialect);
476		end;
477
478	<	procedure TFBAttachment.ExecImmediate(TPB: array of byte; sql: string);
478	>	procedure TFBAttachment.ExecImmediate(TPB: array of byte; sql: AnsiString);
479		begin
480		ExecImmediate(StartTransaction(TPB,taCommit),sql,FSQLDialect);
481		end;
482
483	<	function TFBAttachment.ExecuteSQL(TPB: array of byte; sql: string;
483	>	function TFBAttachment.ExecuteSQL(TPB: array of byte; sql: AnsiString;
484		SQLDialect: integer; params: array of const): IResults;
485		begin
486	<	Result := ExecuteSQL(StartTransaction(TPB,taCommit),sql,FSQLDialect,params);
486	>	Result := ExecuteSQL(StartTransaction(TPB,taCommit),sql,SQLDialect,params);
487		end;
488
489	<	function TFBAttachment.ExecuteSQL(transaction: ITransaction; sql: string;
489	>	function TFBAttachment.ExecuteSQL(transaction: ITransaction; sql: AnsiString;
490		SQLDialect: integer; params: array of const): IResults;
491		begin
492		with Prepare(transaction,sql,SQLDialect) do
#	Line 249 | Line 496 | begin
496		end;
497		end;
498
499	<	function TFBAttachment.ExecuteSQL(TPB: array of byte; sql: string;
499	>	function TFBAttachment.ExecuteSQL(TPB: array of byte; sql: AnsiString;
500		params: array of const): IResults;
501		begin
502		Result := ExecuteSQL(StartTransaction(TPB,taCommit),sql,params);
503		end;
504
505	<	function TFBAttachment.ExecuteSQL(transaction: ITransaction; sql: string;
505	>	function TFBAttachment.ExecuteSQL(transaction: ITransaction; sql: AnsiString;
506		params: array of const): IResults;
507		begin
508		with Prepare(transaction,sql,FSQLDialect) do
#	Line 265 | Line 512 | begin
512		end;
513		end;
514
515	<	function TFBAttachment.OpenCursor(transaction: ITransaction; sql: string;
515	>	function TFBAttachment.OpenCursor(transaction: ITransaction; sql: AnsiString;
516		aSQLDialect: integer): IResultSet;
517		begin
518		Result := OpenCursor(transaction,sql,aSQLDialect,[]);
519		end;
520
521	<	function TFBAttachment.OpenCursor(transaction: ITransaction; sql: string;
521	>	function TFBAttachment.OpenCursor(transaction: ITransaction; sql: AnsiString;
522		aSQLDialect: integer; params: array of const): IResultSet;
523		var Statement: IStatement;
524		begin
#	Line 281 | Line 528 | begin
528		Result := Statement.OpenCursor;
529		end;
530
531	<	function TFBAttachment.OpenCursor(transaction: ITransaction; sql: string
531	>	function TFBAttachment.OpenCursor(transaction: ITransaction; sql: AnsiString
532		): IResultSet;
533		begin
534		Result := OpenCursor(transaction,sql,FSQLDialect,[]);
535		end;
536
537	<	function TFBAttachment.OpenCursor(transaction: ITransaction; sql: string;
537	>	function TFBAttachment.OpenCursor(transaction: ITransaction; sql: AnsiString;
538		params: array of const): IResultSet;
539		begin
540		Result := OpenCursor(transaction,sql,FSQLDialect,params);
541		end;
542
543		function TFBAttachment.OpenCursorAtStart(transaction: ITransaction;
544	<	sql: string; aSQLDialect: integer): IResultSet;
544	>	sql: AnsiString; aSQLDialect: integer): IResultSet;
545		begin
546		Result := OpenCursor(transaction,sql,aSQLDialect,[]);
547		Result.FetchNext;
548		end;
549
550		function TFBAttachment.OpenCursorAtStart(transaction: ITransaction;
551	<	sql: string; aSQLDialect: integer; params: array of const): IResultSet;
551	>	sql: AnsiString; aSQLDialect: integer; params: array of const): IResultSet;
552		begin
553		Result := OpenCursor(transaction,sql,aSQLDialect,params);
554		Result.FetchNext;
555		end;
556
557	<	function TFBAttachment.OpenCursorAtStart(transaction: ITransaction; sql: string
557	>	function TFBAttachment.OpenCursorAtStart(transaction: ITransaction; sql: AnsiString
558		): IResultSet;
559		begin
560		Result := OpenCursorAtStart(transaction,sql,FSQLDialect,[]);
561		end;
562
563		function TFBAttachment.OpenCursorAtStart(transaction: ITransaction;
564	<	sql: string; params: array of const): IResultSet;
564	>	sql: AnsiString; params: array of const): IResultSet;
565		begin
566		Result := OpenCursorAtStart(transaction,sql,FSQLDialect,params);
567		end;
568
569	<	function TFBAttachment.OpenCursorAtStart(sql: string): IResultSet;
569	>	function TFBAttachment.OpenCursorAtStart(sql: AnsiString): IResultSet;
570		begin
571		Result := OpenCursorAtStart(sql,[]);
572		end;
573
574	<	function TFBAttachment.OpenCursorAtStart(sql: string;
574	>	function TFBAttachment.OpenCursorAtStart(sql: AnsiString;
575		params: array of const): IResultSet;
576		begin
577		Result := OpenCursorAtStart(StartTransaction([isc_tpb_read,isc_tpb_wait,isc_tpb_concurrency],taCommit),sql,FSQLDialect,params);
578		end;
579
580	<	function TFBAttachment.Prepare(transaction: ITransaction; sql: string
580	>	function TFBAttachment.Prepare(transaction: ITransaction; sql: AnsiString
581		): IStatement;
582		begin
583		Result := Prepare(transaction,sql,FSQLDialect);
584		end;
585
586		function TFBAttachment.PrepareWithNamedParameters(transaction: ITransaction;
587	<	sql: string; GenerateParamNames: boolean): IStatement;
587	>	sql: AnsiString; GenerateParamNames: boolean): IStatement;
588		begin
589		Result := PrepareWithNamedParameters(transaction,sql,FSQLDialect,GenerateParamNames);
590		end;
591
592	<	function TFBAttachment.GetEventHandler(Event: string): IEvents;
592	>	function TFBAttachment.GetEventHandler(Event: AnsiString): IEvents;
593		var S: TStringList;
594		begin
595		S := TStringList.Create;
#	Line 365 | Line 612 | begin
612		Result := OpenBlob(Transaction,Field.GetBlobMetadata, Field.AsQuad,BPB);
613		end;
614
615	+	function TFBAttachment.GetDBInformation(Requests: array of byte
616	+	): IDBInformation;
617	+	var ReqBuffer: PByte;
618	+	i: integer;
619	+	begin
620	+	CheckHandle;
621	+	if Length(Requests) = 1 then
622	+	Result := GetDBInformation(Requests[0])
623	+	else
624	+	begin
625	+	GetMem(ReqBuffer,Length(Requests));
626	+	try
627	+	for i := 0 to Length(Requests) - 1 do
628	+	ReqBuffer[i] := Requests[i];
629	+
630	+	Result := GetDBInfo(ReqBuffer,Length(Requests));
631	+
632	+	finally
633	+	FreeMem(ReqBuffer);
634	+	end;
635	+	end;
636	+	end;
637	+
638	+	function TFBAttachment.GetDBInformation(Request: byte): IDBInformation;
639	+	begin
640	+	CheckHandle;
641	+	Result := GetDBInfo(@Request,1);
642	+	end;
643	+
644	+	function TFBAttachment.GetDBInformation(Requests: IDIRB): IDBInformation;
645	+	begin
646	+	CheckHandle;
647	+	with Requests as TDIRB do
648	+	Result := GetDBInfo(getBuffer,getDataLength);
649	+	end;
650	+
651	+	function TFBAttachment.GetConnectString: AnsiString;
652	+	begin
653	+	Result := FDatabaseName;
654	+	end;
655	+
656	+	function TFBAttachment.GetRemoteProtocol: AnsiString;
657	+	begin
658	+	Result := FRemoteProtocol;
659	+	end;
660	+
661	+	function TFBAttachment.GetAuthenticationMethod: AnsiString;
662	+	begin
663	+	Result := FAuthMethod;
664	+	end;
665	+
666	+	function TFBAttachment.GetSecurityDatabase: AnsiString;
667	+	begin
668	+	Result := FSecDatabase;
669	+	end;
670	+
671	+	function TFBAttachment.GetODSMajorVersion: integer;
672	+	begin
673	+	Result := FODSMajorVersion;
674	+	end;
675	+
676	+	function TFBAttachment.GetODSMinorVersion: integer;
677	+	begin
678	+	Result := FODSMinorVersion;
679	+	end;
680	+
681	+	function TFBAttachment.HasDefaultCharSet: boolean;
682	+	begin
683	+	Result := FHasDefaultCharSet
684	+	end;
685	+
686	+	function TFBAttachment.GetDefaultCharSetID: integer;
687	+	begin
688	+	Result := FCharsetID;
689	+	end;
690	+
691	+	function TFBAttachment.GetCharsetName(CharSetID: integer): AnsiString;
692	+	var i: integer;
693	+	begin
694	+	Result := '';
695	+	if (CharSetID >= Low(CharSetMap)) and (CharSetID <= High(CharSetMap)) and
696	+	(CharSetMap[CharSetID].CharSetID = CharSetID) then
697	+	begin
698	+	Result := CharSetMap[CharSetID].CharSetName;
699	+	Exit;
700	+	end;
701	+
702	+	for i := 0 to Length(FUserCharSetMap) - 1 do
703	+	if FUserCharSetMap[i].CharSetID = CharSetID then
704	+	begin
705	+	Result := FUserCharSetMap[i].CharSetName;
706	+	Exit;
707	+	end;
708	+	end;
709	+
710	+	function TFBAttachment.CharSetID2CodePage(CharSetID: integer;
711	+	var CodePage: TSystemCodePage): boolean;
712	+	var i: integer;
713	+	begin
714	+	Result := (CharSetID >= Low(CharSetMap)) and (CharSetID <= High(CharSetMap))
715	+	and (CharSetMap[CharSetID].CharSetID = CharSetID);
716	+	if Result then
717	+	begin
718	+	CodePage := CharSetMap[CharSetID].CodePage;
719	+	Result := true;
720	+	Exit;
721	+	end;
722	+
723	+	for i := 0 to Length(FUserCharSetMap) - 1 do
724	+	if FUserCharSetMap[i].CharSetID = CharSetID then
725	+	begin
726	+	CodePage := FUserCharSetMap[i].CodePage;
727	+	Result := true;
728	+	Exit;
729	+	end;
730	+	end;
731	+
732	+	function TFBAttachment.CodePage2CharSetID(CodePage: TSystemCodePage;
733	+	var CharSetID: integer): boolean;
734	+	var i: integer;
735	+	begin
736	+	Result := false;
737	+	for i := Low(CharSetMap) to High(CharSetMap) do
738	+	if (CharSetMap[i].AllowReverseLookup) and (CharSetMap[i].CodePage = CodePage) then
739	+	begin
740	+	CharSetID := CharSetMap[i].CharSetID;
741	+	Result := true;
742	+	Exit;
743	+	end;
744	+
745	+	for i := 0 to Length(FUserCharSetMap) - 1 do
746	+	if (FUserCharSetMap[i].AllowReverseLookup) and (FUserCharSetMap[i].CodePage = CodePage) then
747	+	begin
748	+	CharSetID := FUserCharSetMap[i].CharSetID;
749	+	Result := true;
750	+	Exit;
751	+	end;
752	+	end;
753	+
754	+	function TFBAttachment.CharSetName2CharSetID(CharSetName: AnsiString;
755	+	var CharSetID: integer): boolean;
756	+	var i: integer;
757	+	begin
758	+	Result := false;
759	+	for i := Low(CharSetMap) to High(CharSetMap) do
760	+	if AnsiCompareStr(CharSetMap[i].CharSetName, CharSetName) = 0 then
761	+	begin
762	+	CharSetID := CharSetMap[i].CharSetID;
763	+	Result := true;
764	+	Exit;
765	+	end;
766	+
767	+	for i := 0 to Length(FUserCharSetMap) - 1 do
768	+	if AnsiCompareStr(FUserCharSetMap[i].CharSetName, CharSetName) = 0 then
769	+	begin
770	+	CharSetID := FUserCharSetMap[i].CharSetID;
771	+	Result := true;
772	+	Exit;
773	+	end;
774	+	end;
775	+
776	+	function TFBAttachment.CharSetWidth(CharSetID: integer; var Width: integer
777	+	): boolean;
778	+	var i: integer;
779	+	begin
780	+	Result := (CharSetID >= Low(CharSetMap)) and (CharSetID <= High(CharSetMap))
781	+	and (CharSetMap[CharSetID].CharSetID = CharSetID);
782	+	if Result then
783	+	begin
784	+	Width := CharSetMap[CharSetID].CharSetWidth;
785	+	Result := true;
786	+	Exit;
787	+	end;
788	+
789	+	for i := 0 to Length(FUserCharSetMap) - 1 do
790	+	if FUserCharSetMap[i].CharSetID = CharSetID then
791	+	begin
792	+	Width := FUserCharSetMap[i].CharSetWidth;
793	+	Result := true;
794	+	Exit;
795	+	end;
796	+	end;
797	+
798	+	const
799	+	sqlLookupCharSet = 'Select RDB$CHARACTER_SET_ID, RDB$BYTES_PER_CHARACTER From RDB$CHARACTER_SETS '+
800	+	'Where RDB$SYSTEM_FLAG = 0 and RDB$CHARACTER_SET_NAME = UPPER(?)';
801	+
802	+	procedure TFBAttachment.RegisterCharSet(CharSetName: AnsiString;
803	+	CodePage: TSystemCodePage; AllowReverseLookup: boolean; out CharSetID: integer
804	+	);
805	+	var CharSets: IResultSet;
806	+	idx: integer;
807	+	begin
808	+	if CharSetName2CharSetID(CharSetName,CharSetID) then
809	+	IBError(ibxeCharacterSetExists,[CharSetName]);
810	+
811	+	CharSets := OpenCursorAtStart(sqlLookupCharSet,[CharSetName]);
812	+	if CharSets.IsEof then
813	+	IBError(ibxeUnknownUserCharSet,[CharSetName]);
814	+
815	+	idx := Length(FUserCharSetMap);
816	+	SetLength(FUserCharSetMap,idx+1);
817	+	FUserCharSetMap[idx].AllowReverseLookup := AllowReverseLookup;
818	+	FUserCharSetMap[idx].CharSetID := CharSets[0].AsInteger;
819	+	FUserCharSetMap[idx].CharSetName := AnsiUpperCase(CharSetName);
820	+	FUserCharSetMap[idx].CharSetWidth := CharSets[1].AsInteger;
821	+	FUserCharSetMap[idx].CodePage := CodePage;
822	+	CharSetID := CharSets[0].AsInteger;
823	+	end;
824	+
825		end.
826

Diff Legend

–	Removed lines
+	Added lines
<	Changed lines
>	Changed lines