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 115 by tony, Fri Jan 19 09:23:39 2018 UTC vs.
Revision 231 by tony, Mon Apr 16 08:32:21 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 311 | Line 322 | begin
322		end;
323		end;
324
325	<	function FormatIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
315	<	begin
316	<	Value := Trim(Value);
317	<	if Dialect = 1 then
318	<	Value := AnsiUpperCase(Value)
319	<	else
320	<	if (Value <> '') and (Value[1] = '"') then
321	<	Value := '"' + StringReplace (TrimRight(Value), '"', '""', [rfReplaceAll]) + '"'
322	<	else
323	<	Value := AnsiUpperCase(Value);
324	<	Result := Value;
325	<	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 343 | Line 343 | begin
343		Result := Value;
344		end;
345
346	<	function FormatIdentifierValueNC(Dialect: Integer; Value: AnsiString): AnsiString;
347	<	begin
348	<	Value := Trim(Value);
349	<	if Dialect = 1 then
350	<	Value := AnsiUpperCase(Value)
351	<	else
352	<	begin
353	<	if (Value <> '') and (Value[1] = '"') then
354	<	begin
355	<	Delete(Value, 1, 1);
356	<	Delete(Value, Length(Value), 1);
357	<	Value := AnsiUpperCase(StringReplace (Value, '""', '"', [rfReplaceAll]));
358	<	end
359	<	else
360	<	Value := AnsiUpperCase(Value);
361	<	end;
362	<	Result := Value;
363	<	end;
364	<
365	<	function ExtractIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
366	<	begin
367	<	Value := Trim(Value);
368	<	if Dialect = 1 then
369	<	Value := AnsiUpperCase(Value)
370	<	else
371	<	begin
372	<	if (Value <> '') and (Value[1] = '"') then
373	<	begin
374	<	Delete(Value, 1, 1);
375	<	Delete(Value, Length(Value), 1);
376	<	Value := StringReplace (Value, '""', '"', [rfReplaceAll]);
377	<	end
378	<	else
379	<	Value := AnsiUpperCase(Value);
380	<	end;
381	<	Result := Value;
382	<	end;
346	>	{Returns true if "w" is a Firebird SQL reserved word}
347
348		function IsReservedWord(w: AnsiString): boolean;
349		var i: integer;
#	Line 391 | Line 355 | begin
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
362		if Dialect = 1 then
363		Value := AnsiUpperCase(Trim(Value))
364		else
365	<	Value := '"' + Value + '"';
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
#	Line 412 | Line 380 | begin
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	+
408	+	function GetProtocol(scheme: AnsiString): TProtocolAll;
409	+	begin
410	+	scheme := AnsiUpperCase(scheme);
411	+	if scheme = 'INET' then
412	+	Result := inet
413	+	else
414	+	if scheme = 'INET4' then
415	+	Result := inet4
416	+	else
417	+	if scheme = 'INET6' then
418	+	Result := inet6
419	+	else
420	+	if scheme = 'XNET' then
421	+	Result := xnet
422	+	else
423	+	if scheme = 'WNET' then
424	+	Result := wnet
425	+	end;
426	+
427	+	var RegexObj: TRegExpr;
428	+	begin
429	+	ServerName := '';
430	+	DatabaseName := ConnectString;
431	+	PortNo := '';
432	+	Protocol := unknownProtocol;
433	+	RegexObj := TRegExpr.Create;
434	+	try
435	+	{extact database file spec}
436	+	RegexObj.ModifierG := false; {turn off greedy matches}
437	+	RegexObj.Expression := '^([a-zA-Z46]+)://([a-zA-Z0-9\-\.]*)(|:[0-9a-zA-Z\-]+)/(.*)$';
438	+	Result := RegexObj.Exec(ConnectString);
439	+	if Result then
440	+	begin
441	+	{URL type connect string}
442	+	Protocol := GetProtocol(RegexObj.Match[1]);
443	+	ServerName := RegexObj.Match[2];
444	+	if RegexObj.MatchLen[3] > 0 then
445	+	PortNo := system.Copy(ConnectString,RegexObj.MatchPos[3]+1,RegexObj.MatchLen[3]-1);
446	+	DatabaseName := RegexObj.Match[4];
447	+	if ServerName = '' then
448	+	DatabaseName := '/' + DatabaseName;
449	+	end
450	+	else
451	+	begin
452	+	{URL type connect string - local loop}
453	+	RegexObj.Expression := '^([a-zA-Z46]+)://(.*)$';
454	+	Result := RegexObj.Exec(ConnectString);
455	+	if Result then
456	+	begin
457	+	Protocol := GetProtocol(RegexObj.Match[1]);
458	+	DatabaseName := RegexObj.Match[2];
459	+	end
460	+	else
461	+	begin
462	+	RegexObj.Expression := '^([a-zA-Z]:\\.*)';
463	+	Result := RegexObj.Exec(ConnectString);
464	+	if Result then
465	+	Protocol := Local {Windows with leading drive ID}
466	+	else
467	+	begin
468	+	RegexObj.Expression := '^([a-zA-Z0-9\-\.]+)(|/[0-9a-zA-Z\-]+):(.*)$';
469	+	Result := RegexObj.Exec(ConnectString);
470	+	if Result then
471	+	begin
472	+	{Legacy TCP Format}
473	+	ServerName := RegexObj.Match[1];
474	+	if RegexObj.MatchLen[2] > 0 then
475	+	PortNo := system.Copy(ConnectString,RegexObj.MatchPos[2]+1,RegexObj.MatchLen[2]-1);
476	+	DatabaseName := RegexObj.Match[3];
477	+	Protocol := TCP;
478	+	end
479	+	else
480	+	begin
481	+	RegexObj.Expression := '^\\\\([a-zA-Z0-9\-\.]+)(|@[0-9a-zA-Z\-]+)\\(.*)$';
482	+	Result := RegexObj.Exec(ConnectString);
483	+	if Result then
484	+	begin
485	+	{Netbui}
486	+	ServerName := RegexObj.Match[1];
487	+	if RegexObj.MatchLen[2] > 0 then
488	+	PortNo := system.Copy(ConnectString,RegexObj.MatchPos[2]+1,RegexObj.MatchLen[2]-1);
489	+	DatabaseName := RegexObj.Match[3];
490	+	Protocol := NamedPipe
491	+	end
492	+	else
493	+	begin
494	+	Result := true;
495	+	Protocol := Local; {Assume local}
496	+	end;
497	+	end;
498	+	end;
499	+	end;
500	+	end;
501	+	finally
502	+	RegexObj.Free;
503	+	end;
504	+	end;
505	+
506	+	function GetProtocol(ConnectString: AnsiString): TProtocolAll;
507	+	var ServerName,
508	+	DatabaseName: AnsiString;
509	+	PortNo: AnsiString;
510	+	begin
511	+	ParseConnectString(ConnectString,ServerName,DatabaseName,Result,PortNo);
512	+	end;
513	+
514	+	{$ELSE}
515	+	{cruder version of above for Delphi. Older versions lack regular expression
516	+	handling.}
517	+	function ExtractConnectString(const CreateSQL: AnsiString;
518	+	var ConnectString: AnsiString): boolean;
519	+	var i: integer;
520	+	begin
521	+	Result := false;
522	+	i := Pos('''',CreateSQL);
523	+	if i > 0 then
524	+	begin
525	+	ConnectString := CreateSQL;
526	+	delete(ConnectString,1,i);
527	+	i := Pos('''',ConnectString);
528	+	if i > 0 then
529	+	begin
530	+	delete(ConnectString,i,Length(ConnectString)-i+1);
531	+	Result := true;
532	+	end;
533	+	end;
534	+	end;
535	+
536	+	function GetProtocol(ConnectString: AnsiString): TProtocolAll;
537	+	begin
538	+	Result := unknownProtocol; {not implemented for Delphi}
539	+	end;
540	+
541	+	function ParseConnectString(ConnectString: AnsiString;
542	+	var ServerName, DatabaseName: AnsiString; var Protocol: TProtocolAll;
543	+	var PortNo: AnsiString): boolean;
544	+	begin
545	+	Result := false;
546	+	end;
547	+
548	+	{$ENDIF}
549	+
550	+	{Make a connect string in format appropriate protocol}
551	+
552	+	function MakeConnectString(ServerName, DatabaseName: AnsiString;
553	+	Protocol: TProtocol; PortNo: AnsiString): AnsiString;
554	+
555	+	function FormatURL: AnsiString;
556	+	begin
557	+	if (ServerName = '') and (Pos('/',DatabaseName) <= 1) then
558	+	Result := DatabaseName
559	+	else
560	+	Result := ServerName + '/' + DatabaseName;
561	+	end;
562	+
563	+	begin
564	+	if PortNo <> '' then
565	+	case Protocol of
566	+	NamedPipe:
567	+	ServerName := ServerName + '@' + PortNo;
568	+	Local,
569	+	SPX,
570	+	xnet: {do nothing};
571	+	TCP:
572	+	ServerName := ServerName + '/' + PortNo;
573	+	else
574	+	ServerName := ServerName + ':' + PortNo;
575	+	end;
576	+
577	+	case Protocol of
578	+	TCP:        Result := ServerName + ':' + DatabaseName; {do not localize}
579	+	SPX:        Result := ServerName + '@' + DatabaseName; {do not localize}
580	+	NamedPipe:  Result := '\\' + ServerName + '\' + DatabaseName; {do not localize}
581	+	Local:      Result := DatabaseName; {do not localize}
582	+	inet:       Result := 'inet://' + FormatURL; {do not localize}
583	+	inet4:       Result := 'inet4://' + FormatURL; {do not localize}
584	+	inet6:       Result := 'inet6://' + FormatURL; {do not localize}
585	+	wnet:       Result := 'wnet://' + FormatURL; {do not localize}
586	+	xnet:       Result := 'xnet://' + FormatURL;  {do not localize}
587	+	end;
588	+	end;
589	+
590	+	{Format an SQL Identifier according to SQL Dialect with encapsulation if necessary}
591	+
592		function QuoteIdentifierIfNeeded(Dialect: Integer; Value: AnsiString): AnsiString;
593		begin
594		if (Dialect = 3) and
595		(IsReservedWord(Value) or not IsSQLIdentifier(Value) or (AnsiUpperCase(Value) <> Value)) then
596	<	Result := '"' + Value + '"'
596	>	Result := '"' + StringReplace (TrimRight(Value), '"', '""', [rfReplaceAll]) + '"'
597		else
598		Result := Value
599		end;
600
601	+	{Replaces unknown characters in a string with underscores}
602	+
603		function Space2Underscore(s: AnsiString): AnsiString;
604		var
605		k: integer;
606		begin
607		Result := s;
608		for k := 1 to Length(s) do
609	<	if not (Result[k] in ['0'..'9','A'..'Z','_','$'])  then
609	>	if not (Result[k] in ValidSQLIdentifierChars)  then
610		Result[k] := '_';
611		end;
612
613	+	{Reformats an SQL string with single quotes duplicated.}
614	+
615		function SQLSafeString(const s: AnsiString): AnsiString;
616		begin
617		Result := StringReplace(s,'''','''''',[rfReplaceAll]);

Diff Legend

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