ViewVC Help

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

root/public/ibx/branches/udr/client/IBUtils.pas

Comparing ibx/trunk/fbintf/IBUtils.pas (file contents):
Revision 56 by tony, Mon Mar 6 10:20:02 2017 UTC vs.
Revision 209 by tony, Wed Mar 14 12:48:51 2018 UTC

#	Line 33 | Line 33
33
34		unit IBUtils;
35		{$IFDEF MSWINDOWS}
36	<	{$DEFINE WINDOWS}
36	>	{$DEFINE WINDOWS}
37		{$ENDIF}
38
39		{$IFDEF FPC}
40		{$Mode Delphi}
41		{$codepage UTF8}
42	+	{$define HASREQEX}
43		{$ENDIF}
44
45	+
46		interface
47
48	<	uses Classes, SysUtils;
48	>	uses Classes, SysUtils, IB;
49
50		const
51		CRLF = #13 + #10;
#	Line 52 | Line 54 | const
54		TAB  = #9;
55		NULL_TERMINATOR = #0;
56
57	<	sqlReservedWords: array [0..197] of string = (
57	>	sqlReservedWords: array [0..198] of string = (
58		'ADD',
59		'ADMIN',
60		'ALL',
#	Line 144 | Line 146 | const
146		'INTO',
147		'IS',
148		'JOIN',
149	+	'KEY',
150		'LEADING',
151		'LEFT',
152		'LIKE',
#	Line 258 | Line 261 | function Min(n1, n2: Integer): Integer;
261		function RandomString(iLength: Integer): AnsiString;
262		function RandomInteger(iLow, iHigh: Integer): Integer;
263		function StripString(st: AnsiString; CharsToStrip: AnsiString): AnsiString;
261	–	function FormatIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
262	–	function FormatIdentifierValue(Dialect: Integer; Value: AnsiString): AnsiString;
263	–	function FormatIdentifierValueNC(Dialect: Integer; Value: AnsiString): AnsiString;
264		function ExtractIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
265		function QuoteIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
266		function QuoteIdentifierIfNeeded(Dialect: Integer; Value: AnsiString): AnsiString;
267		function Space2Underscore(s: AnsiString): AnsiString;
268		function SQLSafeString(const s: AnsiString): AnsiString;
269	+	function IsSQLIdentifier(Value: AnsiString): boolean;
270	+	function ExtractConnectString(const CreateSQL: AnsiString; var ConnectString: AnsiString): boolean;
271	+	function MakeConnectString(ServerName, DatabaseName: AnsiString; Protocol: TProtocol;
272	+	PortNo: AnsiString = ''): AnsiString;
273	+	function ParseConnectString(ConnectString: AnsiString;
274	+	var ServerName, DatabaseName: AnsiString; var Protocol: TProtocolAll;
275	+	var PortNo: AnsiString): boolean;
276	+	function GetProtocol(ConnectString: AnsiString): TProtocolAll;
277
278		implementation
279
280	+	{$IFDEF HASREQEX}
281	+	uses RegExpr;
282	+	{$ENDIF}
283	+
284		function Max(n1, n2: Integer): Integer;
285		begin
286		if (n1 > n2) then
#	Line 310 | Line 322 | begin
322		end;
323		end;
324
325	<	function FormatIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
314	<	begin
315	<	Value := Trim(Value);
316	<	if Dialect = 1 then
317	<	Value := AnsiUpperCase(Value)
318	<	else
319	<	if (Value <> '') and (Value[1] = '"') then
320	<	Value := '"' + StringReplace (TrimRight(Value), '"', '""', [rfReplaceAll]) + '"'
321	<	else
322	<	Value := AnsiUpperCase(Value);
323	<	Result := Value;
324	<	end;
325	>	{Extracts SQL Identifier typically from a  Dialect 3 encoding}
326
327	<	function FormatIdentifierValue(Dialect: Integer; Value: AnsiString): AnsiString;
327	>	function ExtractIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
328		begin
329		Value := Trim(Value);
330		if Dialect = 1 then
#	Line 342 | Line 343 | begin
343		Result := Value;
344		end;
345
346	<	function FormatIdentifierValueNC(Dialect: Integer; Value: AnsiString): AnsiString;
346	>	{Returns true if "w" is a Firebird SQL reserved word}
347	>
348	>	function IsReservedWord(w: AnsiString): boolean;
349	>	var i: integer;
350	>	begin
351	>	Result := true;
352	>	for i := 0 to Length(sqlReservedWords) - 1 do
353	>	if w = sqlReservedWords[i] then
354	>	Exit;
355	>	Result := false;
356	>	end;
357	>
358	>	{Format an SQL Identifier according to SQL Dialect}
359	>
360	>	function QuoteIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
361		begin
347	–	Value := Trim(Value);
362		if Dialect = 1 then
363	<	Value := AnsiUpperCase(Value)
363	>	Value := AnsiUpperCase(Trim(Value))
364		else
365	<	begin
366	<	if (Value <> '') and (Value[1] = '"') then
365	>	Value := '"' + StringReplace (Value, '""', '"', [rfReplaceAll]) + '"';
366	>	Result := Value;
367	>	end;
368	>
369	>	const
370	>	ValidSQLIdentifierChars = ['A'..'Z','a'..'z','0'..'9','_','$'];
371	>
372	>	{Returns true if the value is a valid SQL Identifier - note lower case accepted}
373	>
374	>	function IsSQLIdentifier(Value: AnsiString): boolean;
375	>	var i: integer;
376	>	begin
377	>	Result := false;
378	>	for i := 1 to Length(Value) do
379	>	if not (Value[i] in ValidSQLIdentifierChars) then Exit;
380	>	Result := true;
381	>	end;
382	>
383	>	{Extracts the Database Connect string from a Create Database Statement}
384	>
385	>	{$IFDEF HASREQEX}
386	>	function ExtractConnectString(const CreateSQL: AnsiString;
387	>	var ConnectString: AnsiString): boolean;
388	>	var RegexObj: TRegExpr;
389	>	begin
390	>	RegexObj := TRegExpr.Create;
391	>	try
392	>	{extact database file spec}
393	>	RegexObj.ModifierG := false; {turn off greedy matches}
394	>	RegexObj.ModifierI := true; {case insensitive match}
395	>	RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +''(.*)''';
396	>	Result := RegexObj.Exec(CreateSQL);
397	>	if Result then
398	>	ConnectString := RegexObj.Match[2];
399	>	finally
400	>	RegexObj.Free;
401	>	end;
402	>	end;
403	>
404	>	function ParseConnectString(ConnectString: AnsiString; var ServerName,
405	>	DatabaseName: AnsiString; var Protocol: TProtocolAll; var PortNo: AnsiString
406	>	): boolean;
407	>	var RegexObj: TRegExpr;
408	>	scheme: AnsiString;
409	>	begin
410	>	ServerName := '';
411	>	DatabaseName := ConnectString;
412	>	PortNo := '';
413	>	Protocol := unknownProtocol;
414	>	RegexObj := TRegExpr.Create;
415	>	try
416	>	{extact database file spec}
417	>	RegexObj.ModifierG := false; {turn off greedy matches}
418	>	RegexObj.Expression := '^([a-zA-Z]+)://([a-zA-Z0-9\-\.]+)(|:[0-9a-zA-Z\-]+)/(.*)$';
419	>	Result := RegexObj.Exec(ConnectString);
420	>	if Result then
421		begin
422	<	Delete(Value, 1, 1);
423	<	Delete(Value, Length(Value), 1);
424	<	Value := AnsiUpperCase(StringReplace (Value, '""', '"', [rfReplaceAll]));
422	>	{URL type connect string}
423	>	scheme := AnsiUpperCase(RegexObj.Match[1]);
424	>	ServerName := RegexObj.Match[2];
425	>	if RegexObj.MatchLen[3] > 0 then
426	>	PortNo := system.Copy(ConnectString,RegexObj.MatchPos[3]+1,RegexObj.MatchLen[3]-1);
427	>	DatabaseName := RegexObj.Match[4];
428	>	if scheme = 'INET' then
429	>	Protocol := inet
430	>	else
431	>	if scheme = 'XNET' then
432	>	Protocol := xnet
433	>	else
434	>	if scheme = 'WNET' then
435	>	Protocol := wnet
436		end
437		else
438	<	Value := AnsiUpperCase(Value);
438	>	begin
439	>	RegexObj.Expression := '^([a-zA-Z]:\\.*)';
440	>	Result := RegexObj.Exec(ConnectString);
441	>	if Result then
442	>	Protocol := Local {Windows with leading drive ID}
443	>	else
444	>	begin
445	>	RegexObj.Expression := '^([a-zA-Z0-9\-\.]+)(|/[0-9a-zA-Z\-]+):(.*)$';
446	>	Result := RegexObj.Exec(ConnectString);
447	>	if Result then
448	>	begin
449	>	{Legacy TCP Format}
450	>	ServerName := RegexObj.Match[1];
451	>	if RegexObj.MatchLen[2] > 0 then
452	>	PortNo := system.Copy(ConnectString,RegexObj.MatchPos[2]+1,RegexObj.MatchLen[2]-1);
453	>	DatabaseName := RegexObj.Match[3];
454	>	Protocol := TCP;
455	>	end
456	>	else
457	>	begin
458	>	RegexObj.Expression := '^\\\\([a-zA-Z0-9\-\.]+)(|@[0-9a-zA-Z\-]+)\\(.*)$';
459	>	Result := RegexObj.Exec(ConnectString);
460	>	if Result then
461	>	begin
462	>	{Netbui}
463	>	ServerName := RegexObj.Match[1];
464	>	if RegexObj.MatchLen[2] > 0 then
465	>	PortNo := system.Copy(ConnectString,RegexObj.MatchPos[2]+1,RegexObj.MatchLen[2]-1);
466	>	DatabaseName := RegexObj.Match[3];
467	>	Protocol := NamedPipe
468	>	end
469	>	else
470	>	begin
471	>	Result := true;
472	>	Protocol := Local; {Assume local}
473	>	end;
474	>	end;
475	>	end;
476	>	end;
477	>	finally
478	>	RegexObj.Free;
479		end;
361	–	Result := Value;
480		end;
481
482	<	function ExtractIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
482	>	function GetProtocol(ConnectString: AnsiString): TProtocolAll;
483	>	var ServerName,
484	>	DatabaseName: AnsiString;
485	>	PortNo: AnsiString;
486	>	begin
487	>	ParseConnectString(ConnectString,ServerName,DatabaseName,Result,PortNo);
488	>	end;
489	>
490	>	{$ELSE}
491	>	{cruder version of above for Delphi. Older versions lack regular expression
492	>	handling.}
493	>	function ExtractConnectString(const CreateSQL: AnsiString;
494	>	var ConnectString: AnsiString): boolean;
495	>	var i: integer;
496		begin
497	<	Value := Trim(Value);
498	<	if Dialect = 1 then
499	<	Value := AnsiUpperCase(Value)
369	<	else
497	>	Result := false;
498	>	i := Pos('''',CreateSQL);
499	>	if i > 0 then
500		begin
501	<	if (Value <> '') and (Value[1] = '"') then
501	>	ConnectString := CreateSQL;
502	>	delete(ConnectString,1,i);
503	>	i := Pos('''',ConnectString);
504	>	if i > 0 then
505		begin
506	<	Delete(Value, 1, 1);
507	<	Delete(Value, Length(Value), 1);
508	<	Value := StringReplace (Value, '""', '"', [rfReplaceAll]);
376	<	end
377	<	else
378	<	Value := AnsiUpperCase(Value);
506	>	delete(ConnectString,i,Length(ConnectString)-i+1);
507	>	Result := true;
508	>	end;
509		end;
380	–	Result := Value;
510		end;
511
512	<	function IsReservedWord(w: AnsiString): boolean;
384	<	var i: integer;
512	>	function GetProtocol(ConnectString: AnsiString): TProtocolAll;
513		begin
514	<	Result := true;
387	<	for i := 0 to Length(sqlReservedWords) - 1 do
388	<	if w = sqlReservedWords[i] then
389	<	Exit;
390	<	Result := false;
514	>	Result := unknownProtocol; {not implemented for Delphi}
515		end;
516
517	<	function QuoteIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
517	>	function ParseConnectString(ConnectString: AnsiString;
518	>	var ServerName, DatabaseName: AnsiString; var Protocol: TProtocolAll;
519	>	var PortNo: AnsiString): boolean;
520		begin
521	<	if Dialect = 1 then
396	<	Value := AnsiUpperCase(Trim(Value))
397	<	else
398	<	Value := '"' + Value + '"';
399	<	Result := Value;
521	>	Result := false;
522		end;
523
524	+	{$ENDIF}
525	+
526	+	{Make a connect string in format appropriate protocol}
527	+
528	+	function MakeConnectString(ServerName, DatabaseName: AnsiString;
529	+	Protocol: TProtocol; PortNo: AnsiString): AnsiString;
530	+	begin
531	+	if PortNo <> '' then
532	+	case Protocol of
533	+	NamedPipe:
534	+	ServerName := ServerName + '@' + PortNo;
535	+	Local,
536	+	SPX,
537	+	xnet: {do nothing};
538	+	TCP:
539	+	ServerName := ServerName + '/' + PortNo;
540	+	else
541	+	ServerName := ServerName + ':' + PortNo;
542	+	end;
543	+
544	+	case Protocol of
545	+	TCP:        Result := ServerName + ':' + DatabaseName; {do not localize}
546	+	SPX:        Result := ServerName + '@' + DatabaseName; {do not localize}
547	+	NamedPipe:  Result := '\\' + ServerName + '\' + DatabaseName; {do not localize}
548	+	Local:      Result := DatabaseName; {do not localize}
549	+	inet:       Result := 'inet://' + ServerName + '/'+ DatabaseName; {do not localize}
550	+	wnet:       Result := 'wnet://' + ServerName + '/'+ DatabaseName; {do not localize}
551	+	xnet:       Result := 'xnet://' + ServerName + '/'+ DatabaseName;  {do not localize}
552	+	end;
553	+	end;
554	+
555	+	{Format an SQL Identifier according to SQL Dialect with encapsulation if necessary}
556	+
557		function QuoteIdentifierIfNeeded(Dialect: Integer; Value: AnsiString): AnsiString;
558		begin
559		if (Dialect = 3) and
560	<	((AnsiUpperCase(Value) <> Value) or IsReservedWord(Value)) then
561	<	Result := '"' + Value + '"'
560	>	(IsReservedWord(Value) or not IsSQLIdentifier(Value) or (AnsiUpperCase(Value) <> Value)) then
561	>	Result := '"' + StringReplace (TrimRight(Value), '"', '""', [rfReplaceAll]) + '"'
562		else
563		Result := Value
564		end;
565
566	+	{Replaces unknown characters in a string with underscores}
567	+
568		function Space2Underscore(s: AnsiString): AnsiString;
569		var
570		k: integer;
571		begin
572		Result := s;
573		for k := 1 to Length(s) do
574	<	if not (Result[k] in ['0'..'9','A'..'Z','_','$'])  then
574	>	if not (Result[k] in ValidSQLIdentifierChars)  then
575		Result[k] := '_';
576		end;
577
578	+	{Reformats an SQL string with single quotes duplicated.}
579	+
580		function SQLSafeString(const s: AnsiString): AnsiString;
581		begin
582		Result := StringReplace(s,'''','''''',[rfReplaceAll]);

Diff Legend

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